X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=54163e25873f263d2ab84d00f9b61f51bb966b92;hb=93fd3c5fd9f215515162b7016beb25d30d10104b;hp=a4efbed6ab799974d26f4c4f67490dfbaad31094;hpb=5990cb670168c59ed9591459fdc0cbcff36c56a8;p=elisp%2Fgnus.git- diff --git a/lisp/gnus.el b/lisp/gnus.el index a4efbed..54163e2 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -250,10 +250,10 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.6.14" +(defconst gnus-version-number "0.34" "Version number for this version of Gnus.") -(defconst gnus-version (format "Gnus v%s" gnus-version-number) +(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) "Version string for this version of Gnus.") (defcustom gnus-inhibit-startup-message nil @@ -268,8 +268,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 +287,9 @@ 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-annotation-in-region-p 'ignore) + (defalias 'gnus-decode-rfc1522 'ignore)) ;; We define these group faces here to avoid the display ;; update forced when creating new faces. @@ -600,6 +600,33 @@ be set in `.emacs' instead." "Face used for normal interest read articles.") +;;; +;;; 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)) + +(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*") @@ -610,17 +637,17 @@ be set in `.emacs' instead." (defface gnus-splash-face '((((class color) (background dark)) - (:foreground "ForestGreen")) + (:foreground "Brown")) (((class color) (background light)) - (:foreground "ForestGreen")) + (:foreground "Brown")) (t ())) - "Level 1 newsgroup face.") + "Face of the splash screen.") (defun gnus-splash () (save-excursion - (switch-to-buffer (get-buffer-create gnus-group-buffer)) + (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer)) (let ((buffer-read-only nil)) (erase-buffer) (unless gnus-inhibit-startup-message @@ -688,9 +715,10 @@ be set in `.emacs' instead." (eval-when (load) (let ((command (format "%s" this-command))) - (when (and (string-match "gnus" command) - (not (string-match "gnus-other-frame" command))) - (gnus-splash)))) + (if (and (string-match "gnus" command) + (not (string-match "gnus-other-frame" command))) + (gnus-splash) + (gnus-get-buffer-create gnus-group-buffer)))) ;;; Do the rest. @@ -753,8 +781,7 @@ used to 899, you would say something along these lines: (or (getenv "NNTPSERVER") (and (file-readable-p gnus-nntpserver-file) (save-excursion - (set-buffer (get-buffer-create " *gnus nntp*")) - (buffer-disable-undo (current-buffer)) + (set-buffer (gnus-get-buffer-create " *gnus nntp*")) (insert-file-contents gnus-nntpserver-file) (let ((name (buffer-string))) (prog1 @@ -838,6 +865,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) + sexp string)) (defcustom gnus-secondary-servers nil @@ -1344,7 +1372,6 @@ want." 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 @@ -1379,6 +1406,7 @@ want." ;;; 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) @@ -1419,11 +1447,11 @@ want." (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"))))) + 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. @@ -1465,9 +1493,6 @@ want." (defvar gnus-article-buffer "*Article*") (defvar gnus-server-buffer "*Server*") -(defvar gnus-buffer-list nil - "Gnus buffers that should be killed on exit.") - (defvar gnus-slave nil "Whether this Gnus is a slave or not.") @@ -1543,20 +1568,18 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (cdr package))))) '(("metamail" metamail-buffer) ("info" Info-goto-node) - ("hexl" hexl-hex-string-to-integer) ("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) ("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) ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages - rmail-show-message) + rmail-show-message rmail-output-to-rmail-file) ("gnus-audio" :interactive t gnus-audio-play) ("gnus-xmas" gnus-xmas-splash) ("gnus-soup" :interactive t @@ -1586,7 +1609,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 @@ -1623,8 +1646,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") 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" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh) + gnus-uu-decode-binhex-view gnus-uu-unmark-thread + gnus-uu-mark-over) + ("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 @@ -1634,7 +1658,11 @@ 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-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) @@ -1662,23 +1690,24 @@ 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-art" :interactive t gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-word-wrap gnus-article-remove-cr gnus-article-remove-trailing-blank-lines gnus-article-display-x-face gnus-article-de-quoted-unreadable - gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp + 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-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-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) @@ -1776,7 +1805,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 @@ -1930,6 +1959,7 @@ This restriction may disappear in later versions of Gnus." ;;; Gnus Utility Functions ;;; + (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." @@ -1944,52 +1974,39 @@ STRINGS will be evaluated in normal `or' order." (setq strings nil))) string)) -;; Add the current buffer to the list of buffers to be killed on exit. -(defun gnus-add-current-to-buffer-list () - (or (memq (current-buffer) gnus-buffer-list) - (push (current-buffer) gnus-buffer-list))) - (defun gnus-version (&optional arg) "Version number of this version of Gnus. If ARG, insert string at point." (interactive "P") - (let ((methods gnus-valid-select-methods) - (mess gnus-version) - meth) - ;; Go through all the legal select methods and add their version - ;; numbers to the total version string. Only the backends that are - ;; currently in use will have their message numbers taken into - ;; consideration. - (while methods - (setq meth (intern (concat (caar methods) "-version"))) - (and (boundp meth) - (stringp (symbol-value meth)) - (setq mess (concat mess "; " (symbol-value meth)))) - (setq methods (cdr methods))) - (if arg - (insert (message mess)) - (message mess)))) + (if arg + (insert (message gnus-version)) + (message gnus-version))) (defun gnus-continuum-version (version) "Return VERSION as a floating point number." (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) - (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) - (setq major (string-to-number (match-string 1 number))) - (setq minor (string-to-number (match-string 2 number))) - (setq least (if (match-beginning 3) + (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" - (cond - ((member alpha '("(ding)" "d")) "4.99") - ((member alpha '("September" "s")) "5.01") - ((member alpha '("Red" "r")) "5.03")) + (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)))))) @@ -2032,7 +2049,7 @@ g -- Group name." (setq prompt (match-string 1 string))) (setq i (match-end 0)) ;; We basically emulate just about everything that - ;; `interactive' does, but adds the "g" and "G" specs. + ;; `interactive' does, but add the specs listed above. (push (cond ((= c ?a) @@ -2173,7 +2190,14 @@ 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. - (eq (gnus-request-type group article) 'news)))) + (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)))))) ;; Returns a list of writable groups. (defun gnus-writable-groups () @@ -2242,9 +2266,11 @@ that that variable is buffer-local to the summary buffers." (gnus-server-to-method method)) ((equal method gnus-select-method) gnus-select-method) - ((and (stringp (car method)) group) + ((and (stringp (car method)) + group) (gnus-server-extend-method group method)) - ((and method (not group) + ((and method + (not group) (equal (cadr method) "")) method) (t @@ -2461,7 +2487,7 @@ also examines the topic parameters." (when params (setq params (delq name params)) (while (assq name params) - (setq params (delq (assq name params) params))) + (gnus-pull name params)) (gnus-info-set-params info params)))))) (defun gnus-group-add-score (group &optional score) @@ -2476,7 +2502,10 @@ If SCORE is nil, add 1 to the score of GROUP." "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 -1) (skip 1) + (let* ((name "") + (foreign "") + (depth 0) + (skip 1) (levels (or levels (progn (while (string-match "\\." group skip) @@ -2673,11 +2702,14 @@ Disallow illegal group names." (defun gnus-read-method (prompt) "Prompt the user for a method. Allow completion over sensible values." - (let ((method - (completing-read - prompt (append gnus-valid-select-methods gnus-predefined-server-alist - gnus-server-alist) - nil t nil 'gnus-method-history))) + (let* ((servers + (append gnus-valid-select-methods + 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)) @@ -2687,7 +2719,7 @@ Allow completion over sensible values." (assoc method gnus-valid-select-methods)) (read-string "Address: ") ""))) - ((assoc method gnus-server-alist) + ((assoc method servers) method) (t (list (intern method) "")))))