From: morioka Date: Thu, 27 Nov 1997 07:59:06 +0000 (+0000) Subject: Quassia Gnus v0.13. X-Git-Tag: qgnus-0_13 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=97063e29f85dc31ea55a1483a6dbe97028d9a419;p=elisp%2Fgnus.git- Quassia Gnus v0.13. --- diff --git a/GNUS-NEWS b/GNUS-NEWS index c7e4692..e4a0a67 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -53,3 +53,13 @@ limit. *** \\1-expressions are now valid in `nnmail-split-methods'. +*** The `custom-face-lookup' function has been removed. +If you used this function in your initialization files, you must +rewrite them to use `face-spec-set' instead. + +*** Cancelling now uses the current select method. Symbolic prefix +`a' forces normal posting method. + +*** New command to translate M******** sm*rtq**t*s into proper text +-- `W d'. + diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f22101b..6c3c820 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -2,12 +2,97 @@ Sat Sep 13 21:21:38 1997 Lars Magne Ingebrigtsen * gnus.el: Quassia Gnus v0.1 is released. +Thu Nov 6 20:43:05 1997 Lars Magne Ingebrigtsen + + * gnus.el: Quassia Gnus v0.13 is released. + +Thu Nov 6 20:30:14 1997 Lars Magne Ingebrigtsen + + * nnlistserv.el: New backend. + +Thu Nov 6 01:53:51 1997 Stefan Waldherr + + * nnweb.el (nnweb-dejanewsold-search): New function. + +Thu Nov 6 01:52:43 1997 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-change-level): Really delete multiple + instances. + +Wed Nov 5 14:04:54 1997 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-update-topic-line): Possibly fix nil + numbers. + + * gnus-sum.el (gnus-summary-show-article): New command and + keystroke. + +Tue Nov 4 06:29:58 1997 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-adaptive): Use the home score file. + +Sat Oct 25 05:52:22 1997 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-save): Hide headers in the right + buffer. + + * gnus-picon.el (gnus-picons-xbm-face): New face. + +Sat Oct 25 00:39:42 1997 Lars Balker Rasmussen + + * gnus-art.el (gnus-article-fill-paragraph): New command and + keystroke. + +1997-10-16 Colin Rafferty + + * message.el (message-make-fqdn): Made certain that user-mail is + not nil. + +Sat Oct 25 00:18:32 1997 David S. Goldberg + + * gnus-art.el (article-hide-boring-headers): Use many-to. + +Fri Oct 24 23:48:39 1997 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-display-pairs): Don't add two bars. + (gnus-picons-try-face): Set the foreground color on the bar. + (gnus-picons-group-exluded-groups): New variable. + (gnus-group-display-picons): Use it. + +Mon Oct 13 00:01:35 1997 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-group-path): Translate file chars. + (gnus-agent-batch-fetch): New command. + (gnus-agent-fetch-group): Message. + +Sun Oct 12 23:54:55 1997 ISO-2022-JP + + * gnus-agent.el (gnus-agent-article-file-coding-system): New + variable. + +Sun Oct 12 16:46:11 1997 Lars Magne Ingebrigtsen + + * dgnushack.el (lpath): Reversed. + + * gnus-msg.el (gnus-summary-cancel-article): Use sym prefix. + + * gnus-art.el (article-translate-characters): New function. + (article-treat-dumbquotes): New command and keystroke. + +Sun Oct 5 20:09:31 1997 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-alist): No ' and " in News:. + + * gnus-msg.el (gnus-inews-insert-archive-gcc): Comp warn. + Sat Oct 4 00:53:55 1997 Lars Magne Ingebrigtsen * gnus.el: Quassia Gnus v0.12 is released. Sat Oct 4 00:16:39 1997 Lars Magne Ingebrigtsen + * gnus.el (gnus-plugged): Moved here. + * nnmail.el (nnmail-delete-incoming): Changed default to nil. * gnus-int.el (gnus-request-scan): Don't do anything if diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index ba6a73b..aad6016 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -30,8 +30,8 @@ (require 'cl) (require 'bytecomp) -(push "." load-path) (push "~/lisp/custom" load-path) +(push "." load-path) (require 'lpath) (defalias 'device-sound-enabled-p 'ignore) @@ -67,7 +67,7 @@ Modify to suit your needs.")) file elc) (condition-case () (require 'w3-forms) - (error (setq files (delete "nnweb.el" files)))) + (error (setq files (delete "nnweb.el" (delete "nnlistserv.el" files))))) (while (setq file (pop files)) (when (or (and (not xemacs) (not (member file '("gnus-xmas.el" "gnus-picon.el" diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index cb893b5..853c0ca 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -61,6 +61,7 @@ (defvar gnus-agent-spam-hashtb nil) (defvar gnus-agent-file-name nil) (defvar gnus-agent-send-mail-function nil) +(defvar gnus-agent-article-file-coding-system 'no-conversion) ;; Dynamic variables (defvar gnus-headers) @@ -303,7 +304,8 @@ agent minor mode in all Gnus buffers." (error "No group on the current line")) (let ((gnus-command-method (gnus-find-method-for-group group))) (gnus-agent-with-fetch - (gnus-agent-fetch-group-1 group gnus-command-method)))) + (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." @@ -452,7 +454,8 @@ the actual number of articles toggled is returned." (let* ((gnus-command-method method) (file (gnus-agent-lib-file "active"))) (gnus-make-directory (file-name-directory file)) - (write-region (point-min) (point-max) file nil 'silent) + (let ((coding-system-for-write gnus-agent-article-file-coding-system)) + (write-region (point-min) (point-max) file nil 'silent)) (when (file-exists-p (gnus-agent-lib-file "groups")) (delete-file (gnus-agent-lib-file "groups")))))) @@ -466,7 +469,8 @@ the actual number of articles toggled is returned." (defun gnus-agent-group-path (group) "Translate GROUP into a path." - (nnheader-replace-chars-in-string group ?. ?/)) + (nnheader-translate-file-chars + (nnheader-replace-chars-in-string group ?. ?/))) @@ -759,6 +763,14 @@ the actual number of articles toggled is returned." (concat (gnus-agent-directory) (gnus-agent-group-path group) "/" (if (stringp article) article (string-to-number article)))) +;;;###autoload +(defun gnus-agent-batch-fetch () + "Start Gnus and fetch session." + (interactive) + (gnus) + (gnus-agent-fetch-session) + (gnus-group-exit)) + (defun gnus-agent-fetch-session () "Fetch all articles and headers that are eligible for fetching." (interactive) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index ec6cbbe..c5875af 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -129,13 +129,14 @@ this list." (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', `newsgroups', `followup-to', -`reply-to', and `date'." +`reply-to', `date', `long-to', and `many-to'." :type '(set (const :tag "Headers with no content." empty) (const :tag "Newsgroups with only one group." newsgroups) (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 "Very long To header." long-to)) + (const :tag "Very long To header." long-to) + (const :tag "Multiple To headers." many-to)) :group 'gnus-article-hiding) (defcustom gnus-signature-separator '("^-- $" "^-- *$") @@ -618,6 +619,7 @@ Initialized from `text-mode-syntax-table.") If given a negative prefix, always show; if given a positive prefix, always hide." (interactive (gnus-article-hidden-arg)) + (current-buffer) (if (gnus-article-check-hidden-text 'headers arg) ;; Show boring headers as well. (gnus-article-show-hidden-text 'boring-headers) @@ -747,7 +749,21 @@ always hide." ((eq elem 'long-to) (let ((to (message-fetch-field "to"))) (when (> (length to) 1024) - (gnus-article-hide-header "to"))))))))))) + (gnus-article-hide-header "to")))) + ((eq elem 'many-to) + (let ((to-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))))))))))))) (defun gnus-article-hide-header (header) (save-excursion @@ -762,7 +778,29 @@ always hide." (point-max))) 'boring-headers)))) -;; Written by Per Abrahamsen . +(defun article-treat-dumbquotes () + "Translate M******** sm*rtq**t*s into proper text." + (interactive) + (article-translate-characters "\221\222\223\223" "`'\"\"")) + +(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 + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (let ((buffer-read-only nil) + (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-treat-overstrike () "Translate overstrikes into bold text." (interactive) @@ -1424,7 +1462,9 @@ This format is defined by the `gnus-article-time-format' variable." (let ((gnus-visible-headers (or gnus-saved-headers gnus-visible-headers)) (gnus-article-buffer save-buffer)) - (gnus-article-hide-headers 1 t))) + (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") @@ -1747,6 +1787,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-date-user article-date-lapsed article-emphasize + article-treat-dumbquotes (article-show-all . gnus-article-show-all-headers)))) ;;; @@ -2572,7 +2613,7 @@ groups." ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1) ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t gnus-button-fetch-group 4) - ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2) + ("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-fetch-group 2) ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 2) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 6196b5f..3292970 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -2714,7 +2714,10 @@ of groups killed." gnus-list-of-killed-groups) (setcdr (cdr entry) (cdddr entry))) ((member group gnus-zombie-list) - (setq gnus-zombie-list (delete 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) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 86d5941..4ed6e7c 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -287,14 +287,17 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (push-mark) (goto-char beg))) -(defun gnus-summary-cancel-article (n) - "Cancel an article you posted." - (interactive "P") +(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")) (gnus-set-global-variables) (let ((articles (gnus-summary-work-articles n)) (message-post-method `(lambda (arg) - (gnus-post-method nil ,gnus-newsgroup-name))) + (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name))) article) (while (setq article (pop articles)) (when (gnus-summary-select-article t nil nil article) @@ -983,9 +986,8 @@ this is a reply." (group (or group gnus-newsgroup-name "")) (gcc-self-val (and gnus-newsgroup-name - (setq gcc-self-val - (gnus-group-find-parameter - gnus-newsgroup-name 'gcc-self)))) + (gnus-group-find-parameter + gnus-newsgroup-name 'gcc-self))) result (groups (cond diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index cf511bb..d478236 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -84,6 +84,11 @@ Some people may want to add \"unknown\" to this list." :type 'boolean :group 'picons) +(defcustom gnus-picons-group-excluded-groups nil + "*If this regexp matches the group name, group picons will be disabled." + :type 'regexp + :group 'picons) + (defcustom gnus-picons-x-face-file-name (format "/tmp/picon-xface.%s.xbm" (user-login-name)) "The name of the file in which to store the converted X-face header." @@ -139,6 +144,10 @@ please tell me so that we can list it." (string)) :group 'picons) +(defface gnus-picons-xbm-face '((t (:foreground "black" :background "white"))) + "Face to show X face" + :group 'picons) + ;;; Internal variables: (defvar gnus-picons-processes-alist nil @@ -155,8 +164,7 @@ List of pairs (KEY . NAME) where KEY is (USER HOST DBS) and NAME is an URL.") (defvar gnus-article-annotations nil "List of annotations added/removed when selecting an article") (defvar gnus-x-face-annotations nil - "List of annotations added/removed when selecting an article with an -X-Face.") + "List of annotations added/removed when selecting an article with an X-Face.") (defvar gnus-picons-jobs-alist nil "List of jobs that still need be done. @@ -285,7 +293,7 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" (process-send-eof process)))) (defun gnus-article-display-picons () - "Display faces for an author and his/her domain in gnus-picons-display-where." + "Display faces for an author and her domain in gnus-picons-display-where." (interactive) (let (from at-idx) (when (and (featurep 'xpm) @@ -335,16 +343,20 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" "Display icons for the group in the gnus-picons-display-where buffer." (interactive) (when (and (featurep 'xpm) - (or (not (fboundp 'device-type)) (equal (device-type) 'x))) + (or (not (fboundp 'device-type)) (equal (device-type) 'x)) + (or (null gnus-picons-group-excluded-groups) + (not (string-match gnus-picons-group-excluded-groups + gnus-newsgroup-name)))) (save-excursion (gnus-picons-prepare-for-annotations 'gnus-group-annotations) (if (null gnus-picons-piconsearch-url) (setq gnus-group-annotations (gnus-picons-display-pairs - (gnus-picons-lookup-pairs (reverse (message-tokenize-header - (gnus-group-real-name gnus-newsgroup-name) - ".")) - gnus-picons-news-directories) + (gnus-picons-lookup-pairs + (reverse (message-tokenize-header + (gnus-group-real-name gnus-newsgroup-name) + ".")) + gnus-picons-news-directories) t ".")) (push (list 'gnus-group-annotations 'search nil (message-tokenize-header @@ -418,27 +430,20 @@ none, and whose CDR is the corresponding element of DOMAINS." "Display picons in list PAIRS." (let ((domain-p (and gnus-picons-display-as-address dot-p)) pair picons) - (if (and bar-p domain-p right-p) - (setq picons (gnus-picons-display-glyph - (gnus-picons-try-face gnus-xmas-glyph-directory - "bar.") - nil right-p))) - (while pairs - (setq pair (pop pairs) - picons (nconc picons - (gnus-picons-display-picon-or-name (car pair) - (cadr pair) - right-p) + (when (and bar-p domain-p right-p) + (setq picons (gnus-picons-display-glyph + (let ((gnus-picons-file-suffixes '("xbm"))) + (gnus-picons-try-face + gnus-xmas-glyph-directory "bar.")) + nil right-p))) + (while (setq pair (pop pairs)) + (setq picons (nconc picons + (gnus-picons-display-picon-or-name + (car pair) (cadr pair) right-p) (if (and domain-p pairs) (list (gnus-picons-make-annotation (vector 'string :data dot-p) nil 'text nil nil nil right-p)))))) - (if (and bar-p domain-p (not right-p)) - (setq picons (nconc picons - (gnus-picons-display-glyph - (gnus-picons-try-face gnus-xmas-glyph-directory - "bar.") - nil right-p)))) picons)) (defun gnus-picons-try-face (dir &optional filebase) @@ -447,21 +452,24 @@ none, and whose CDR is the corresponding element of DOMAINS." (key (concat dir filebase)) (glyph (cdr (assoc key gnus-picons-glyph-alist))) (suffixes gnus-picons-file-suffixes) - f) - (while (and suffixes (null glyph)) - (when (file-exists-p (setq f (expand-file-name (concat filebase - (pop suffixes)) - dir))) - (setq glyph (make-glyph f)) + f suf) + (while (setq suf (pop suffixes)) + (when (file-exists-p (setq f (expand-file-name + (concat filebase suf) + dir))) + (setq suffixes nil + glyph (make-glyph f)) + (when (equal suf "xbm") + (set-glyph-face glyph 'gnus-picons-xbm-face)) (push (cons key glyph) gnus-picons-glyph-alist))) glyph)) (defun gnus-picons-display-glyph (glyph &optional part rightp) - (let ((new (gnus-picons-make-annotation glyph (point) - 'text nil nil nil rightp))) + (let ((new (gnus-picons-make-annotation + glyph (point) 'text nil nil nil rightp))) (when (and part gnus-picons-display-as-address) - (set-annotation-data new (cons new - (make-glyph (vector 'string :data part)))) + (set-annotation-data + new (cons new (make-glyph (vector 'string :data part)))) (set-annotation-action new 'gnus-picons-action-toggle)) (nconc (list new) @@ -721,8 +729,10 @@ none, and whose CDR is the corresponding element of DOMAINS." (pop job))) ((eq 'bar tag) (gnus-picons-network-display-internal - sym-ann (gnus-picons-try-face gnus-xmas-glyph-directory - "bar.") + sym-ann + (let ((gnus-picons-file-suffixes '("xbm"))) + (gnus-picons-try-face + gnus-xmas-glyph-directory "bar.")) nil (pop job))) ((eq 'search tag);; (SYM-ANN 'search USER ADDRS DBS RIGHT-P) (gnus-picons-network-search diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 36692c7..5888d1a 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -2077,6 +2077,7 @@ SCORE is the score to add." (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. diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index dd6591f..dcaa169 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1206,6 +1206,7 @@ increase the score of each group you read." "I" gnus-summary-increase-score "L" gnus-summary-lower-score "\M-i" gnus-symbolic-argument + "h" gnus-summary-select-article-buffer "V" gnus-summary-score-map "X" gnus-uu-extract-map @@ -1343,7 +1344,8 @@ increase the score of each group you read." "t" gnus-article-hide-headers "v" gnus-summary-verbose-headers "m" gnus-summary-toggle-mime - "h" gnus-article-treat-html) + "h" gnus-article-treat-html + "d" gnus-article-treat-dumbquotes) (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) "a" gnus-article-hide @@ -1579,6 +1581,7 @@ increase the score of each group you read." ["All of the above" gnus-article-strip-blank-lines t] ["Leading space" gnus-article-strip-leading-space 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] ["CR" gnus-article-remove-cr t] @@ -1636,6 +1639,7 @@ increase the score of each group you read." ("Cache" ["Enter article" gnus-cache-enter-article t] ["Remove article" gnus-cache-remove-article 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] @@ -4898,6 +4902,14 @@ displayed, no centering will be performed." ;; 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") diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index b802979..379471f 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -626,7 +626,7 @@ articles in the topic and its subtopics." (when parent (forward-line -1) (gnus-topic-update-topic-line - parent (- old-unread (gnus-group-topic-unread)))) + parent (- (or old-unread 0) (or (gnus-group-topic-unread) 0)))) unread)) (defun gnus-topic-group-indentation () @@ -733,55 +733,59 @@ articles in the topic and its subtopics." "Run when changing levels to enter/remove groups from topics." (save-excursion (set-buffer gnus-group-buffer) - (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. - (when (and (< oldlevel gnus-level-zombie) + (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) - (forward-line -1) - (when (setq alist (assoc (gnus-current-topic) gnus-topic-alist)) - (setcdr alist (gnus-delete-first group (cdr 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))))) + (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." diff --git a/lisp/gnus.el b/lisp/gnus.el index cacbd7d..d27aec0 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -244,7 +244,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.12" +(defconst gnus-version-number "0.13" "Version number for this version of Gnus.") (defconst gnus-version (format "Quassia Gnus v%s" gnus-version-number) diff --git a/lisp/lpath.el b/lisp/lpath.el index c463dfb..a713ff8 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -28,13 +28,13 @@ set-face-stipple mail-abbrevs-setup char-int make-char-table set-char-table-range font-create-object x-color-values widget-make-intangible error-message-string - w3-form-encode-xwfu - )) + w3-form-encode-xwfu md5)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table font-lock-defaults user-full-name user-login-name - gnus-newsgroup-name gnus-article-x-face-too-ugly))) + gnus-newsgroup-name gnus-article-x-face-too-ugly + mail-mode-hook))) (defvar browse-url-browser-function nil) (maybe-fbind '(color-instance-rgb-components make-color-instance color-instance-name specifier-instance diff --git a/lisp/md5.el b/lisp/md5.el index c27fc4a..3fabf29 100644 --- a/lisp/md5.el +++ b/lisp/md5.el @@ -91,7 +91,7 @@ ;;; Code: --------------------------------------------------------------------- -(defvar md5-program "md5" +(defvar md5-program "md5sum" "*Program that reads a message on its standard input and writes an MD5 digest on its output.") diff --git a/lisp/message.el b/lisp/message.el index 2c062d5..3ae0254 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -2705,7 +2705,8 @@ give as trustworthy answer as possible." (string-match "\\." mail-host-address)) mail-host-address) ;; We try `user-mail-address' as a backup. - ((and (string-match "\\." user-mail) + ((and user-mail + (string-match "\\." user-mail) (string-match "@\\(.*\\)\\'" user-mail)) (match-string 1 user-mail)) ;; Default to this bogus thing. diff --git a/lisp/nnlistserv.el b/lisp/nnlistserv.el new file mode 100644 index 0000000..b307fd2 --- /dev/null +++ b/lisp/nnlistserv.el @@ -0,0 +1,156 @@ +;;; nnlsitserv.el --- retrieving articles via web mailing list archives +;; Copyright (C) 1997 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 2, 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Note: You need to have `url' and `w3' installed for this +;; backend to work. + +;;; Code: + +(eval-when-compile (require 'cl)) + +(push '("nnlistserv" none) gnus-valid-select-methods) + +(require 'nnoo) +(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 an 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)) + (nnweb-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)) + (message "%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) + (nnweb-decode-entities) + (while headers + (goto-char (point-min)) + (re-search-forward (format "