X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=395cba41dd9cf1fa8554bb592dc117b71088691a;hb=9bff3e1ed66aee0c93773573fc662b10c4b72a1b;hp=ecc0eb4961f5b8a15ccbd6407658f51e93592460;hpb=a461e8a0532d9534f607028c37be97f1ea674400;p=gnus diff --git a/lisp/gnus.el b/lisp/gnus.el index ecc0eb496..395cba41d 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,5 +1,5 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -41,6 +41,11 @@ :group 'news :group 'mail) +(defgroup gnus-charset nil + "Group character set issues." + :link '(custom-manual "(gnus)Charsets") + :group 'gnus) + (defgroup gnus-cache nil "Cache interface." :group 'gnus) @@ -245,12 +250,16 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Various Various") :group 'gnus) +(defgroup gnus-mime nil + "Variables for controlling the Gnus MIME interface." + :group 'gnus) + (defgroup gnus-exit nil "Exiting gnus." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.13" +(defconst gnus-version-number "0.75" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -268,8 +277,6 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) -;;; Kludges to help the transition from the old `custom.el'. - (unless (featurep 'gnus-xmas) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-delete-overlay 'delete-overlay) @@ -289,7 +296,8 @@ be set in `.emacs' instead." (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-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. @@ -360,6 +368,72 @@ be set in `.emacs' instead." ())) "Level 3 empty newsgroup face.") +(defface gnus-group-news-4-face + '((((class color) + (background dark)) + (:bold t)) + (((class color) + (background light)) + (:bold t)) + (t + ())) + "Level 4 newsgroup face.") + +(defface gnus-group-news-4-empty-face + '((((class color) + (background dark)) + ()) + (((class color) + (background light)) + ()) + (t + ())) + "Level 4 empty newsgroup face.") + +(defface gnus-group-news-5-face + '((((class color) + (background dark)) + (:bold t)) + (((class color) + (background light)) + (:bold t)) + (t + ())) + "Level 5 newsgroup face.") + +(defface gnus-group-news-5-empty-face + '((((class color) + (background dark)) + ()) + (((class color) + (background light)) + ()) + (t + ())) + "Level 5 empty newsgroup face.") + +(defface gnus-group-news-6-face + '((((class color) + (background dark)) + (:bold t)) + (((class color) + (background light)) + (:bold t)) + (t + ())) + "Level 6 newsgroup face.") + +(defface gnus-group-news-6-empty-face + '((((class color) + (background dark)) + ()) + (((class color) + (background light)) + ()) + (t + ())) + "Level 6 empty newsgroup face.") + (defface gnus-group-news-low-face '((((class color) (background dark)) @@ -773,7 +847,7 @@ used to 899, you would say something along these lines: :group 'gnus-files :group 'gnus-server :type 'file) - + ;; This function is used to check both the environment variable ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find ;; an nntp server name default. @@ -782,7 +856,6 @@ used to 899, you would say something along these lines: (and (file-readable-p gnus-nntpserver-file) (save-excursion (set-buffer (gnus-get-buffer-create " *gnus nntp*")) - (buffer-disable-undo (current-buffer)) (insert-file-contents gnus-nntpserver-file) (let ((name (buffer-string))) (prog1 @@ -792,11 +865,10 @@ used to 899, you would say something along these lines: (kill-buffer (current-buffer)))))))) (defcustom gnus-select-method - (condition-case nil + (ignore-errors (nconc - (list 'nntp (or (condition-case nil - (gnus-getenv-nntpserver) - (error nil)) + (list 'nntp (or (ignore-errors + (gnus-getenv-nntpserver)) (when (and gnus-default-nntp-server (not (string= gnus-default-nntp-server ""))) gnus-default-nntp-server) @@ -804,8 +876,7 @@ used to 899, you would say something along these lines: (if (or (null gnus-nntp-service) (equal gnus-nntp-service "nntp")) nil - (list gnus-nntp-service))) - (error nil)) + (list gnus-nntp-service)))) "*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. @@ -866,6 +937,7 @@ 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)) @@ -1081,11 +1153,6 @@ articles. This is not a good idea." :group 'gnus-meta :type 'boolean) -(defcustom gnus-use-demon nil - "If non-nil, Gnus might use some demons." - :group 'gnus-meta - :type 'boolean) - (defcustom gnus-use-scoring t "*If non-nil, enable scoring." :group 'gnus-meta @@ -1343,64 +1410,6 @@ face." :group 'gnus-visual :type 'face) -(defcustom gnus-article-display-hook - (if (and (string-match "XEmacs" emacs-version) - (featurep 'xface)) - '(gnus-article-decode-charset - gnus-article-decode-rfc1522 - gnus-article-hide-headers-if-wanted - gnus-article-hide-boring-headers - gnus-article-treat-overstrike - gnus-article-maybe-highlight - gnus-article-display-x-face) - '(gnus-article-decode-charset - gnus-article-decode-rfc1522 - gnus-article-hide-headers-if-wanted - gnus-article-hide-boring-headers - gnus-article-treat-overstrike - gnus-article-maybe-highlight)) - "*Controls how the article buffer will look. - -If you leave the list empty, the article will appear exactly as it is -stored on the disk. The list entries will hide or highlight various -parts of the article, making it easier to find the information you -want." - :group 'gnus-article-highlight - :group 'gnus-visual - :type 'hook - :options '(gnus-article-add-buttons - gnus-article-add-buttons-to-head - gnus-article-emphasize - gnus-article-fill-cited-article - gnus-article-remove-cr - gnus-article-de-quoted-unreadable - gnus-summary-stop-page-breaking - ;; gnus-summary-caesar-message - ;; gnus-summary-verbose-headers - gnus-summary-toggle-mime - gnus-article-hide - gnus-article-hide-headers - gnus-article-hide-boring-headers - gnus-article-hide-signature - gnus-article-hide-citation - gnus-article-hide-pgp - gnus-article-hide-pem - gnus-article-highlight - gnus-article-highlight-headers - gnus-article-highlight-citation - gnus-article-highlight-signature - gnus-article-date-ut - gnus-article-date-local - gnus-article-date-lapsed - gnus-article-date-original - gnus-article-remove-trailing-blank-lines - gnus-article-strip-leading-blank-lines - gnus-article-strip-multiple-blank-lines - gnus-article-strip-blank-lines - gnus-article-treat-overstrike - gnus-article-display-x-face - gnus-smiley-display)) - (defcustom gnus-article-save-directory gnus-directory "*Name of the directory articles will be saved in (default \"~/News\")." :group 'gnus-article-saving @@ -1409,9 +1418,27 @@ want." (defvar gnus-plugged t "Whether Gnus is plugged or not.") +(defcustom gnus-default-charset 'iso-8859-1 + "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) + +(defcustom gnus-default-posting-charset nil + "Default charset assumed to be used when posting non-ASCII characters. +This variable is overridden on a group-to-group basis by the +gnus-group-posting-charset-alist variable and is only used on groups not +covered by that variable. +If nil, no default charset is assumed when posting." + :type 'symbol + :group 'gnus-charset) + ;;; Internal variables +(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) (defvar gnus-original-article-buffer " *Original Article*") (defvar gnus-newsgroup-name nil) @@ -1459,7 +1486,7 @@ want." ,(nnheader-concat gnus-cache-directory "active")))) "List of predefined (convenience) servers.") -(defvar gnus-topic-indentation "") ;; Obsolete variable. +(defvar gnus-topic-indentation "");; Obsolete variable. (defconst gnus-article-mark-lists '((marked . tick) (replied . reply) @@ -1487,7 +1514,6 @@ want." '((gnus-group-mode "(gnus)The Group Buffer") (gnus-summary-mode "(gnus)The Summary Buffer") (gnus-article-mode "(gnus)The Article Buffer") - (mime/viewer-mode "(gnus)The Article Buffer") (gnus-server-mode "(gnus)The Server Buffer") (gnus-browse-mode "(gnus)Browse Foreign Server") (gnus-tree-mode "(gnus)Tree Display")) @@ -1575,19 +1601,17 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("info" Info-goto-node) ("pp" pp pp-to-string pp-eval-expression) ("qp" quoted-printable-decode-region quoted-printable-decode-string) - ("rfc2047" rfc2047-decode-region rfc2047-decode-string) ("ps-print" ps-print-preprint) ("mail-extr" mail-extract-address-components) ("browse-url" browse-url) ("message" :interactive t message-send-and-exit message-yank-original) - ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time) + ("nnmail" nnmail-split-fancy nnmail-article-group) ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) - ("timezone" timezone-make-date-arpa-standard timezone-fix-time - timezone-make-sortable-date timezone-make-time-string) - ("rmailout" rmail-output) + ("rmailout" rmail-output rmail-output-to-rmail-file) ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages - rmail-show-message) + 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 @@ -1617,7 +1641,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") 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-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 @@ -1655,9 +1679,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") 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" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh - 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 @@ -1667,11 +1690,15 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") 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-bug) + 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-article-display-picons gnus-group-display-picons gnus-picons-article-display-x-face gnus-picons-display-x-face) + ("gnus-picon" gnus-picons-buffer-name) ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p gnus-grouplens-mode) ("smiley" :interactive t gnus-smiley-display) @@ -1687,8 +1714,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") 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-clear-inboxes-moved gnus-group-iterate - gnus-group-group-name) + 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 @@ -1696,7 +1722,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") 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-hack-decode-rfc1522) + 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-word-wrap @@ -1708,8 +1734,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") 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-decode-rfc1522 article-decode-rfc1522 - gnus-start-date-timer gnus-stop-date-timer) + 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) @@ -1750,6 +1777,7 @@ with some simple extensions. %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 @@ -1788,7 +1816,7 @@ such area. 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 illegal to have these specs after a variable-length spec. Well, +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. @@ -1810,7 +1838,7 @@ This restriction may disappear in later versions of Gnus." (define-key keymap (pop keys) 'undefined)))) (defvar gnus-article-mode-map - (let ((keymap (make-keymap))) + (let ((keymap (make-sparse-keymap))) (gnus-suppress-keymap keymap) keymap)) (defvar gnus-summary-mode-map @@ -2009,8 +2037,8 @@ If ARG, insert string at point." "4.99" (+ 5 (* 0.02 (abs - (- (char-int (aref (downcase alpha) 0)) - (char-int ?t)))) + (- (mm-char-int (aref (downcase alpha) 0)) + (mm-char-int ?t)))) -0.01)) minor least) (format "%d.%02d%02d" major minor least)))))) @@ -2299,7 +2327,14 @@ that that variable is buffer-local to the summary buffers." (not (equal server (format "%s:%s" (caaar opened) (cadaar opened))))) (pop opened)) - (caar 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)))) (defmacro gnus-method-equal (ss1 ss2) "Say whether two servers are equal." @@ -2393,16 +2428,30 @@ You should probably use `gnus-find-method-for-group' instead." 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 (gnus-server-get-method nil method))) (while (and methods - (not (equal (gnus-server-get-method nil (car methods)) - gmethod))) + (not (gnus-method-equal + (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 ((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)) @@ -2520,22 +2569,18 @@ just the host name." ;; 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 - (when (string-match ":" group) - (cond ((string-match "+" group) - (let* ((plus (string-match "+" group)) - (colon (string-match ":" group (or plus 0))) - (dot (string-match "\\." group))) - (setq foreign (concat - (substring group (+ 1 plus) - (cond ((null dot) colon) - ((< colon dot) colon) - ((< dot colon) dot))) - ":") - group (substring group (+ 1 colon))))) - (t - (let* ((colon (string-match ":" group))) - (setq foreign (concat (substring group 0 (+ 1 colon))) - group (substring group (+ 1 colon))))))) + (let* ((colon (string-match ":" group)) + (server (and colon (substring group 0 colon))) + (plus (and server (string-match "+" server)))) + (when server + (cond (plus + (setq foreign (substring server (+ 1 plus) + (string-match "\\." server)) + group (substring group (+ 1 colon)))) + (t + (setq foreign server + group (substring group (+ 1 colon))))) + (setq foreign (concat foreign ":")))) ;; collapse group name leaving LEVELS uncollapsed elements (while group (if (and (string-match "\\." group) (> levels 0)) @@ -2623,6 +2668,7 @@ If NEWSGROUP is nil, return the global kill file name instead." (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)) @@ -2691,7 +2737,7 @@ If NEWSGROUP is nil, return the global kill file name instead." (defun gnus-read-group (prompt &optional default) "Prompt the user for a group name. -Disallow illegal group names." +Disallow invalid group names." (let ((prefix "") group) (while (not group) @@ -2700,7 +2746,7 @@ Disallow illegal group names." (setq group (read-string (concat prefix prompt) (cons (or default "") 0) 'gnus-group-history))) - (setq prefix (format "Illegal group name: \"%s\". " group) + (setq prefix (format "Invalid group name: \"%s\". " group) group nil))) group))