From: Lars Magne Ingebrigtsen Date: Tue, 4 Mar 1997 19:47:22 +0000 (+0000) Subject: *** empty log message *** X-Git-Url: http://cgit.sxemacs.org/?a=commitdiff_plain;h=befe3ad306d0bd60bbf58e38530e41b6a5a286fd;p=gnus *** empty log message *** --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a1bceb34d..3e340abba 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,62 @@ +Fri Jun 21 16:36:03 1996 Christoph Wedler + + * gnus-picon.el (gnus-picons-insert-face-if-exists): Total change. + Didn't conform with the conventions for picon databases. Still a + bit (MISC must be searched for explicitly), but otherwise we would + always see the MISC/unknown face. Faster. + (gnus-article-display-picons): Use accordingly. + (gnus-group-display-picons): Use accordingly. + (gnus-picons-try-to-find-face): Optional argument for not using + `gnus-picons-glyph-alist'--otherwise we would always see the same + x-face. + (gnus-picons-display-x-face): Use it. + (gnus-picons-reverse-domain-path): Deletia. + +Fri Jun 21 15:14:33 1996 Lars Magne Ingebrigtsen + + * gnus-vis.el (gnus-group-make-menu-bar): Fix the menu bar + slightly. + + * gnus.el (gnus-thread-total-score-1): Didn't count right. + + * message.el (message-bounce): Would not skip past all blank + lines. + + * gnus.el (gnus-directory): Removed autoload. + (gnus-activate-group): Pass the `method' argument on. + +Fri Jun 21 09:41:53 1996 Hrvoje Niksic + + * gnus-vis.el (gnus-button-alist): Exclude > from mailto button. + +Fri Jun 21 09:37:39 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-article-mode-map): `end-of-bnuffer'. :-) + +Fri Jun 21 09:34:29 1996 Philippe Troin + + * gnus.el (gnus-thread-total-score-1): Don't count non-displayed + articles. + +Fri Jun 21 09:21:11 1996 Lars Magne Ingebrigtsen + + * nnheader.el (nnheader-translate-file-chars): Would give faulty + results on NTs. + +Fri Jun 21 09:08:48 1996 Philippe Troin + + * gnus-cite.el (gnus-article-hide-citation): Would sometimes bug + out. + +Fri Jun 21 09:01:51 1996 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-copy-article-buffer): Would include text + properties on XEmacs. + +Thu Jun 20 18:38:07 1996 Lars Magne Ingebrigtsen + + * message.el (message-mode): Took `C-n' expansion out. + Thu Jun 20 18:35:22 1996 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.2.23 is released. diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 357f7846b..0982f042b 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -326,10 +326,10 @@ always hide." (when marks (setq end (caar marks))) ;; Skip past lines we want to leave visible. - (when (and beg gnus-cited-lines-visible) + (when (and beg end gnus-cited-lines-visible) (goto-char beg) (forward-line gnus-cited-lines-visible) - (if (> (point) end) + (if (>= (point) end) (setq beg nil) (setq beg (point-marker)))) (when (and beg end) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 709b09a5e..5d1778e7a 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -278,14 +278,14 @@ header line with the old Message-ID." (or (memq gnus-article-copy gnus-buffer-list) (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list))) (let ((article-buffer (or article-buffer gnus-article-buffer)) - end beg) + end beg contents) (when (and (get-buffer article-buffer) (buffer-name (get-buffer article-buffer))) (save-excursion (set-buffer article-buffer) (save-restriction (widen) - (copy-to-buffer gnus-article-copy (point-min) (point-max)) + (setq contents (format "%s" (buffer-string))) (set-buffer gnus-original-article-buffer) (goto-char (point-min)) (while (looking-at message-unix-mail-delimiter) @@ -293,7 +293,8 @@ header line with the old Message-ID." (setq beg (point)) (setq end (or (search-forward "\n\n" nil t) (point))) (set-buffer gnus-article-copy) - (gnus-set-text-properties (point-min) (point-max) nil) + (erase-buffer) + (insert contents) (delete-region (goto-char (point-min)) (or (search-forward "\n\n" nil t) (point))) (insert-buffer-substring gnus-original-article-buffer beg end))) diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 23c38183b..7c3f2a774 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -199,7 +199,7 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" ;; append the annotation to gnus-article-annotations for deletion. (setq gnus-x-face-annotations (append - (gnus-picons-try-to-find-face gnus-picons-x-face-file-name) + (gnus-picons-try-to-find-face gnus-picons-x-face-file-name t) gnus-x-face-annotations))) ;; delete the tmp file (delete-file gnus-picons-x-face-file-name))) @@ -207,26 +207,21 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" (defun gnus-article-display-picons () "Display faces for an author and his/her domain in gnus-picons-display-where." (interactive) - (if (and (featurep 'xpm) - (or (not (fboundp 'device-type)) (equal (device-type) 'x)) - (mail-fetch-field "from")) + (let (from at-idx databases) + (when (and (featurep 'xpm) + (or (not (fboundp 'device-type)) (equal (device-type) 'x)) + (setq from (mail-fetch-field "from")) + (setq from (downcase (cadr (mail-extract-address-components + from))) + at-idx (string-match "@" from))) (save-excursion - (let* ((from (mail-fetch-field "from")) - (username - (progn - (string-match "\\([^ \t]+\\)@" from) - (match-string 1 from))) - (hostpath - (concat - (gnus-picons-reverse-domain-path - (replace-in-string - (replace-in-string - (cadr (mail-extract-address-components from)) - ".*@\\(.*\\)\\'" "\\1") - "\\." "/")) "/"))) - (set-buffer (get-buffer-create + (let ((username (substring from 0 at-idx)) + (addrs (nreverse + (message-tokenize-header (substring from (1+ at-idx)) + ".")))) + (set-buffer (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where))) - (gnus-add-current-to-buffer-list) + (gnus-add-current-to-buffer-list) (goto-char (point-min)) (if (and (eq gnus-picons-display-where 'article) gnus-picons-display-article-move-p) @@ -235,34 +230,25 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" (unless (eolp) (push (make-annotation "\n" (point) 'text) gnus-article-annotations))) - - (gnus-picons-remove gnus-article-annotations) - (setq gnus-article-annotations nil) - (when username - (when (equal username from) - (setq username (progn - (string-match "<\\([_a-zA-Z0-9-.]+\\)>" from) - (match-string 1 from)))) - (mapcar (lambda (pathpart) - (setq gnus-article-annotations - (append - (gnus-picons-insert-face-if-exists - (concat - (file-name-as-directory - gnus-picons-database) pathpart) - (concat hostpath (downcase username))) - gnus-article-annotations))) - gnus-picons-user-directories) - (mapcar (lambda (pathpart) - (setq gnus-article-annotations - (append - (gnus-picons-insert-face-if-exists - (concat (file-name-as-directory - gnus-picons-database) pathpart) - (concat hostpath)) - gnus-article-annotations))) - gnus-picons-domain-directories) - (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))) + + (gnus-picons-remove gnus-article-annotations) + (setq gnus-article-annotations nil) + + (setq databases (append gnus-picons-user-directories + gnus-picons-domain-directories)) + (while databases + (setq gnus-article-annotations + (nconc (gnus-picons-insert-face-if-exists + (car databases) + addrs + "unknown") + (gnus-picons-insert-face-if-exists + (car databases) + addrs + (downcase username) t) + gnus-article-annotations)) + (setq databases (cdr databases))) + (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))) (defun gnus-group-display-picons () "Display icons for the group in the gnus-picons-display-where buffer." @@ -290,10 +276,10 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" (setq gnus-group-annotations nil))) (gnus-picons-remove gnus-group-annotations) (setq gnus-group-annotations - (gnus-picons-insert-face-if-exists - (concat (file-name-as-directory gnus-picons-database) - gnus-picons-news-directory) - (replace-in-string gnus-newsgroup-name "\\." "/"))) + (gnus-picons-insert-face-if-exists + gnus-picons-news-directory + (message-tokenize-header gnus-newsgroup-name ".") + "unknown")) (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))) (defsubst gnus-picons-try-suffixes (file) @@ -304,23 +290,39 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" (setq f nil)) f)) -(defun gnus-picons-insert-face-if-exists (path filename) +(defun gnus-picons-insert-face-if-exists (database addrs filename &optional + nobar-p) "Inserts a face at point if I can find one" - (let ((bar (annotations-in-region - (point) (min (point-max) (1+ (point))) - (current-buffer))) - (files (message-tokenize-header filename "/")) + ;; '(gnus-picons-insert-face-if-exists + ; "Database" '("edu" "indiana" "cs") "Name") + ;; looks for: + ;; 1. edu/indiana/cs/Name + ;; 2. edu/indiana/Name + ;; 3. edu/Name + ;; '(gnus-picons-insert-face-if-exists + ;; "Database/MISC" '("edu" "indiana" "cs") "Name") + ;; looks for: + ;; 1. MISC/Name + ;; The special treatment of MISC doesn't conform with the conventions for + ;; picon databases, but otherwise we would always see the MISC/unknown face. + (let ((bar (and (not nobar-p) + (annotations-in-region + (point) (min (point-max) (1+ (point))) + (current-buffer)))) + (path (concat (file-name-as-directory gnus-picons-database) + database "/")) picons found bar-ann) - (while (and files - (file-exists-p path)) - (setq path (concat path "/" (pop files))) + (if (string-match "/MISC" database) + (setq addrs '(""))) + (while (and addrs + (file-accessible-directory-p path)) + (setq path (concat path (pop addrs) "/")) (when (setq found - (or - (gnus-picons-try-suffixes (concat path "/face.")) - (gnus-picons-try-suffixes (concat path "/unknown/face.")))) + (gnus-picons-try-suffixes + (concat path filename "/face."))) (when bar (setq bar-ann (gnus-picons-try-to-find-face - (concat gnus-xmas-glyph-directory "bar.xbm"))) + (concat gnus-xmas-glyph-directory "bar.xbm"))) (when bar-ann (setq picons (nconc picons bar-ann)) (setq bar nil))) @@ -330,13 +332,15 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" (defvar gnus-picons-glyph-alist nil) -(defun gnus-picons-try-to-find-face (path) +(defun gnus-picons-try-to-find-face (path &optional xface-p) "If PATH exists, display it as a bitmap. Returns t if succedded." - (let ((glyph (cdr (assoc path gnus-picons-glyph-alist)))) + (let ((glyph (and (not xface-p) + (cdr (assoc path gnus-picons-glyph-alist))))) (when (or glyph (file-exists-p path)) (unless glyph - (push (cons path (setq glyph (make-glyph path))) - gnus-picons-glyph-alist) + (setq glyph (make-glyph path)) + (unless xface-p + (push (cons path glyph) gnus-picons-glyph-alist)) (set-glyph-face glyph 'default)) (nconc (list (make-annotation glyph (point) 'text)) diff --git a/lisp/gnus-vis.el b/lisp/gnus-vis.el index 4708f17ad..5efaf1fb7 100644 --- a/lisp/gnus-vis.el +++ b/lisp/gnus-vis.el @@ -216,7 +216,7 @@ t gnus-button-message-id 3) ("\\(\n\t ]*\\)>?\\)" 1 t gnus-button-message-id 3) - ("\\(?" 0 t gnus-button-reply 2) + ("\\( \n\t]+\\)>?" 0 t gnus-button-reply 2) ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 0 t gnus-button-url 1) ;; Next regexp stolen from highlight-headers.el. @@ -340,8 +340,8 @@ HEADER is a regexp to match a header. For a fuller explanation, see gnus-group-group-menu gnus-group-mode-map "" '("Groups" ("Listing" - ["List subscribed groups" gnus-group-list-groups t] - ["List all groups" gnus-group-list-all-groups t] + ["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] diff --git a/lisp/gnus.el b/lisp/gnus.el index a9ff4938a..31c5e1c8a 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -37,7 +37,6 @@ (eval-when-compile (require 'cl)) -;;;###autoload (defvar gnus-directory (or (getenv "SAVEDIR") "~/News/") "*Directory variable from which all other Gnus file variables are derived.") @@ -1731,7 +1730,7 @@ variable (string, integer, character, etc).") "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") -(defconst gnus-version-number "5.2.23" +(defconst gnus-version-number "5.2.24" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -8424,14 +8423,23 @@ Unscored articles will be counted as having a score of zero." (gnus-thread-total-score-1 (list thread))))) (defun gnus-thread-total-score-1 (root) - ;; This function find the total score of the thread below ROOT. + ;; This function finds the total score of the thread below ROOT. (setq root (car root)) - (apply gnus-thread-score-function - (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored)) - gnus-summary-default-score 0) - (mapcar 'gnus-thread-total-score - (cdr (gnus-gethash (mail-header-id root) - gnus-newsgroup-dependencies))))) + (let ((number (mail-header-number root))) + (if (and (not (memq number gnus-newsgroup-limit)) + (not (memq number gnus-newsgroup-sparse))) + ;; This article shouldn't be counted. + (apply gnus-thread-score-function + (mapcar 'gnus-thread-total-score + (cdr (gnus-gethash (mail-header-id root) + gnus-newsgroup-dependencies)))) + ;; This article should be counted. + (apply gnus-thread-score-function + (or (cdr (assq number gnus-newsgroup-scored)) + gnus-summary-default-score 0) + (mapcar 'gnus-thread-total-score + (cdr (gnus-gethash (mail-header-id root) + gnus-newsgroup-dependencies))))))) ;; Added by Per Abrahamsen . (defvar gnus-tmp-prev-subject nil) @@ -13479,8 +13487,8 @@ The directory to save in defaults to `gnus-article-save-directory'." "\r" gnus-article-press-button "\t" gnus-article-next-button "\M-\t" gnus-article-prev-button - "<" beginning-of-bnuffer - ">" end-of-bnuffer + "<" beginning-of-buffer + ">" end-of-buffer "\C-c\C-b" gnus-bug) (substitute-key-definition @@ -16047,7 +16055,7 @@ newsgroup." (while list (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) -(defun gnus-activate-group (group &optional scan dont-check &optional method) +(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 (gnus-find-method-for-group group))) @@ -16062,7 +16070,7 @@ newsgroup." (gnus-request-scan group method)) t) (condition-case () - (gnus-request-group group dont-check) + (gnus-request-group group dont-check method) ; (error nil) (quit nil)) (save-excursion diff --git a/lisp/message.el b/lisp/message.el index 94cef42cb..0e69aac34 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -152,7 +152,6 @@ should return the new buffer name.") "*Non-nil means that the message buffer will be killed after sending a message.") (defvar gnus-local-organization) -;;;###autoload (defvar message-user-organization (or (and (boundp 'gnus-local-organization) gnus-local-organization) @@ -834,8 +833,6 @@ C-c C-r message-ceasar-buffer-body (rot13 the message body)." (if (fboundp 'mail-abbrevs-setup) (mail-abbrevs-setup) (funcall (intern "mail-aliases-setup"))) - (define-key message-mode-map "\C-n" 'abbrev-hacking-next-line) - (define-key message-mode-map "\M->" 'abbrev-hacking-end-of-buffer) (run-hooks 'text-mode-hook 'message-mode-hook)) @@ -2807,7 +2804,7 @@ you." ;; We remove everything before the bounced mail. (delete-region (point-min) - (if (re-search-forward "[^ \t]*:" nil t) + (if (re-search-forward "^[^ \n\t]+:" nil t) (match-beginning 0) (point))) (save-restriction diff --git a/lisp/nnheader.el b/lisp/nnheader.el index a43047c73..3c6aaa9a5 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -450,20 +450,22 @@ on your system, you could say something like: file ;; We translate -- but only the file name. We leave the directory ;; alone. - (let* ((new (if (string-match "/[^/]+\\'" file) - ;; This is needed on NT's and stuff. - (substring file (1+ (match-beginning 0))) - ;; Fall back on this. - (file-name-nondirectory file))) - (len (length new)) - (i 0) - trans) + (let* ((i 0) + trans leaf path len) + (if (string-match "/[^/]+\\'" file) + ;; This is needed on NT's and stuff. + (setq leaf (substring file (1+ (match-beginning 0))) + path (substring file 0 (1+ (match-beginning 0)))) + ;; Fall back on this. + (setq leaf (file-name-nondirectory file) + path (file-name-directory file))) + (setq len (length leaf)) (while (< i len) - (when (setq trans (cdr (assq (aref new i) + (when (setq trans (cdr (assq (aref leaf i) nnheader-file-name-translation-alist))) - (aset new i trans)) + (aset leaf i trans)) (incf i)) - (concat (file-name-directory file) new)))) + (concat path leaf)))) (defun nnheader-report (backend &rest args) "Report an error from the BACKEND.