X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=c3980691dfb6d2790cebc8075a482a3b6bd71734;hb=92e487b48b97af4b331420a1870bb7f185fccf99;hp=245a41e01a781bbdeef53c543fc031c063341880;hpb=4a1ba81848ba228b388671d846d1099ea1652390;p=elisp%2Fgnus.git- diff --git a/lisp/gnus.el b/lisp/gnus.el index 245a41e..c398069 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,8 +1,10 @@ ;;; 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 +;; Tatsuya Ichikawa +;; Yoshiki Hayashi ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -41,6 +43,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) @@ -254,11 +261,28 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.50" - "Version number for this version of Gnus.") +(defconst gnus-product-name "T-gnus" + "Product name of this version of gnus.") + +(defconst gnus-version-number "6.10.064" + "Version number for this version of gnus.") + +(defconst gnus-revision-number "04" + "Revision number for this version of gnus.") + +(defconst gnus-original-version-number "0.84" + "Version number for this version of Gnus.") + +(provide 'running-pterodactyl-gnus-0_73-or-later) -(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) - "Version string for this version of Gnus.") +(defconst gnus-original-product-name "Pterodactyl Gnus" + "Product name of the original version of Gnus.") + +(defconst gnus-version + (format "%s %s (based on %s v%s ; for SEMI 1.12/1.13, FLIM 1.12)" + gnus-product-name gnus-version-number + gnus-original-product-name gnus-original-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. @@ -292,7 +316,6 @@ be set in `.emacs' instead." (defalias 'gnus-deactivate-mark 'deactivate-mark) (defalias 'gnus-window-edges 'window-edges) (defalias 'gnus-key-press-event-p 'numberp) - (defalias 'gnus-annotation-in-region-p 'ignore) (defalias 'gnus-decode-rfc1522 'ignore)) ;; We define these group faces here to avoid the display @@ -855,17 +878,16 @@ used to 899, you would say something along these lines: (insert-file-contents gnus-nntpserver-file) (let ((name (buffer-string))) (prog1 - (if (string-match "^[ \t\n]*$" name) + (if (string-match "\\'[ \t\n]*$" name) nil name) (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) @@ -873,8 +895,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. @@ -935,6 +956,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)) @@ -1150,18 +1172,13 @@ 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 :type 'boolean) (defcustom gnus-use-picons nil - "*If non-nil, display picons." + "*If non-nil, display picons in a frame of their own." :group 'gnus-meta :type 'boolean) @@ -1205,6 +1222,7 @@ slower." :group 'gnus-summary-format :type '(radio (function-item gnus-extract-address-components) (function-item mail-extract-address-components) + (function-item std11-extract-address-components) (function :tag "Other"))) (defcustom gnus-carpal nil @@ -1350,7 +1368,7 @@ following 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-level + :group 'gnus-group-levels :type 'function) ;;; Face thingies. @@ -1438,10 +1456,10 @@ want." 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 @@ -1473,6 +1491,23 @@ 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 @@ -1524,7 +1559,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) @@ -1548,13 +1583,29 @@ want." "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") +(defconst semi-gnus-developers + "Semi-gnus Developers: + semi-gnus-en@meadow.scphys.kyoto-u.ac.jp (In English),\ + semi-gnus-ja@meadow.scphys.kyoto-u.ac.jp (In Japanese);" + "The mail address of the Semi-gnus developers.") + +(defcustom gnus-info-filename nil + "*Controls language of gnus Info. +If nil and current-language-environment is Japanese, go to gnus-ja. +Otherwise go to corresponding Info. +This variable can be nil, gnus or gnus-ja." + :group 'gnus-start + :type '(choice (const nil) + (const :tag "English" gnus) + (const :tag "Japanese" gnus-ja))) + (defvar gnus-info-nodes - '((gnus-group-mode "(gnus)The Group Buffer") - (gnus-summary-mode "(gnus)The Summary Buffer") - (gnus-article-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")) + '((gnus-group-mode "The Group Buffer") + (gnus-summary-mode "The Summary Buffer") + (gnus-article-mode "The Article Buffer") + (gnus-server-mode "The Server Buffer") + (gnus-browse-mode "Browse Foreign Server") + (gnus-tree-mode "Tree Display")) "Alist of major modes and related Info nodes.") (defvar gnus-group-buffer "*Group*") @@ -1635,10 +1686,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (if (eq (nth 1 package) ':interactive) (cdddr package) (cdr package))))) - '(("metamail" metamail-buffer) - ("info" Info-goto-node) + '(("info" Info-goto-node) ("pp" pp pp-to-string pp-eval-expression) - ("qp" quoted-printable-decode-region quoted-printable-decode-string) ("ps-print" ps-print-preprint) ("mail-extr" mail-extract-address-components) ("browse-url" browse-url) @@ -1648,7 +1697,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("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-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 @@ -1717,7 +1767,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") 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-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh + 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 @@ -1735,6 +1786,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("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) @@ -1750,8 +1802,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 @@ -1759,21 +1810,20 @@ 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-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 + 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-display-x-face gnus-article-hide-pgp 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-article-edit-done article-decode-encoded-words + gnus-start-date-timer gnus-stop-date-timer) ("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) @@ -1788,6 +1838,19 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("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-offline" + gnus-offline-setup) + ("gnus-offline" :interactive t + gnus-offline-toggle-plugged + gnus-offline-set-unplugged-state + gnus-offline-toggle-auto-hangup + gnus-offline-toggle-on/off-send-mail + gnus-offline-toggle-articles-to-fetch + gnus-offline-toggle-movemail-program + gnus-offline-set-interval-time + gnus-offline-agent-expire) + ("pop3-fma" :interactive t + pop3-fma-set-pop3-password) ("gnus-agent" gnus-open-agent gnus-agent-get-function gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p gnus-agent-get-undownloaded-list gnus-agent-fetch-session @@ -1853,7 +1916,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. @@ -2074,8 +2137,8 @@ If ARG, insert string at point." "4.99" (+ 5 (* 0.02 (abs - (- (mm-char-int (aref (downcase alpha) 0)) - (mm-char-int ?t)))) + (- (char-int (aref (downcase alpha) 0)) + (char-int ?t)))) -0.01)) minor least) (format "%d.%02d%02d" major minor least)))))) @@ -2085,7 +2148,12 @@ If ARG, insert string at point." (interactive) ;; Enlarge info window if needed. (let (gnus-info-buffer) - (Info-goto-node (cadr (assq major-mode gnus-info-nodes))) + (Info-goto-node + (format "(%s)%s" + (or gnus-info-filename + (get-language-info current-language-environment 'gnus-info) + "gnus") + (cadr (assq major-mode gnus-info-nodes)))) (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) @@ -2260,14 +2328,7 @@ that that variable is buffer-local to the summary buffers." "Return non-nil if GROUP (and ARTICLE) come from a news server." (or (gnus-member-of-valid 'post group) ; Ordinary news group. (and (gnus-member-of-valid 'post-mail group) ; Combined group. - (if (or (null article) - (not (< article 0))) - (eq (gnus-request-type group article) 'news) - (if (not (vectorp article)) - nil - ;; It's a real article. - (eq (gnus-request-type group (mail-header-id article)) - 'news)))))) + (eq (gnus-request-type group article) 'news)))) ;; Returns a list of writable groups. (defun gnus-writable-groups () @@ -2364,7 +2425,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." @@ -2377,6 +2445,15 @@ that that variable is buffer-local to the summary buffers." (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) @@ -2458,16 +2535,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)) @@ -2567,7 +2658,6 @@ If SCORE is nil, add 1 to the score of GROUP." (when info (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) -;; Function written by Stainless Steel Rat (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 @@ -2577,6 +2667,7 @@ just the host name." (depth 0) (skip 1) (levels (or levels + gnus-group-uncollapsed-levels (progn (while (string-match "\\." group skip) (setq skip (match-end 0) @@ -2753,7 +2844,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) @@ -2762,7 +2853,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)) @@ -2816,18 +2907,42 @@ As opposed to `gnus', this command will not connect to the local server." (interactive "P") (gnus arg nil 'slave)) +(defcustom gnus-frame-properties nil + "The properties of the frame in which gnus is displayed. Under XEmacs, +the variable `toolbar-news-frame-plist' will be refered instead." + :type '(repeat (cons :format "%v" + (symbol :tag "Parameter") + (sexp :tag "Value"))) + :group 'gnus) + +(defvar gnus-frame nil + "The frame in which gnus is displayed. It is not used under XEmacs.") + ;;;###autoload (defun gnus-other-frame (&optional arg) "Pop up a frame to read news." (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 arg)) + (if (featurep 'xemacs) + (let ((toolbar-news-use-separate-frame t)) + (toolbar-gnus)) + (if (frame-live-p gnus-frame) + (raise-frame gnus-frame) + (setq gnus-frame (make-frame gnus-frame-properties)) + (if (and (gnus-buffer-live-p gnus-group-buffer) + (save-current-buffer + (set-buffer gnus-group-buffer) + (eq 'gnus-group-mode major-mode))) + (progn + (select-frame gnus-frame) + (switch-to-buffer gnus-group-buffer)) + (add-hook 'gnus-exit-gnus-hook + (lambda () + (when (and (frame-live-p gnus-frame) + (cdr (frame-list))) + (delete-frame gnus-frame)) + (setq gnus-frame nil))) + (select-frame gnus-frame) + (gnus arg))))) ;;;###autoload (defun gnus (&optional arg dont-connect slave)