;;; gnus.el --- a newsreader for GNU Emacs
-;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
+;; 1997, 1998, 2000 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
-;; Yoshiki Hayashi <g740685@komaba.ecc.u-tokyo.ac.jp>
+;; Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
(eval '(run-hooks 'gnus-load-hook))
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
-(require 'custom)
-(eval-and-compile
- (if (< emacs-major-version 20)
- (require 'gnus-load)))
-(require 'message)
+(require 'gnus-vers)
(defgroup gnus nil
"The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-product-name "T-gnus"
- "Product name of this version of gnus.")
-
-(defconst gnus-version-number "6.10.061"
- "Version number for this version of gnus.")
-
-(defconst gnus-revision-number "01"
- "Revision number for this version of gnus.")
-
-(defconst gnus-original-version-number "0.79"
- "Version number for this version of Gnus.")
-
-(provide 'running-pterodactyl-gnus-0_73-or-later)
-
-(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.
This variable is used before `.gnus.el' is loaded, so it should
:group 'gnus-start
:type 'boolean)
+(unless (fboundp 'gnus-group-remove-excess-properties)
+ (defalias 'gnus-group-remove-excess-properties 'ignore))
+
+(unless (fboundp 'gnus-set-text-properties)
+ (defalias 'gnus-set-text-properties 'set-text-properties))
+
(unless (featurep 'gnus-xmas)
(defalias 'gnus-make-overlay 'make-overlay)
(defalias 'gnus-delete-overlay 'delete-overlay)
(defalias 'gnus-overlay-put 'overlay-put)
(defalias 'gnus-move-overlay 'move-overlay)
+ (defalias 'gnus-overlay-buffer 'overlay-buffer)
+ (defalias 'gnus-overlay-start 'overlay-start)
(defalias 'gnus-overlay-end 'overlay-end)
(defalias 'gnus-extent-detached-p 'ignore)
(defalias 'gnus-extent-start-open 'ignore)
- (defalias 'gnus-set-text-properties 'set-text-properties)
- (defalias 'gnus-group-remove-excess-properties 'ignore)
(defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
(defalias 'gnus-character-to-event 'identity)
(defalias 'gnus-add-text-properties 'add-text-properties)
(defalias 'gnus-put-text-property 'put-text-property)
- (defalias 'gnus-mode-line-buffer-identification 'identity)
+ (defvar gnus-mode-line-image-cache t)
+ (if (fboundp 'find-image)
+ (defun gnus-mode-line-buffer-identification (line)
+ (let ((str (car-safe line)))
+ (if (and (stringp str)
+ (string-match "^Gnus:" str))
+ (progn (add-text-properties
+ 0 5
+ (list 'display
+ (if (eq t gnus-mode-line-image-cache)
+ (setq gnus-mode-line-image-cache
+ (find-image
+ '((:type xpm :file "gnus-pointer.xpm"
+ :ascent 80)
+ (:type xbm :file "gnus-pointer.xbm"
+ :ascent 80))))
+ gnus-mode-line-image-cache)
+ 'help-echo "This is Gnus")
+ str)
+ (list str))
+ line)))
+ (defalias 'gnus-mode-line-buffer-identification 'identity))
(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-decode-rfc1522 'ignore))
+ ;;(defalias 'gnus-decode-rfc1522 'ignore)
+ )
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
()))
"Face used for normal interest unread articles.")
+(defface gnus-summary-incorporated-face
+ '((t
+ ()))
+ "Face used for incorporated articles.")
+
(defface gnus-summary-high-read-face
'((((class color)
(background dark))
"Insert startup message in current buffer."
;; Insert the message.
(erase-buffer)
- (insert
- (format " %s
+ (cond
+ ((and (fboundp 'find-image)
+ (display-graphic-p)
+ (let* ((bg (face-background 'default))
+ (fg (face-foreground 'gnus-splash-face))
+ (image (find-image
+ `((:type xpm :file "gnus.xpm"
+ :color-symbols (("thing" . "#724214")
+ ("shadow" . "#1e3f03")
+ ("background" . ,bg)))
+ (:type xbm :file "gnus.xbm"
+ :background ,bg :foreground ,fg)))))
+ (when image
+ (insert
+ (propertize
+ (concat gnus-product-name " " gnus-version-number
+ (if (zerop (string-to-number gnus-revision-number))
+ ""
+ (concat " (r" gnus-revision-number ")"))
+ " based on " gnus-original-product-name " v"
+ gnus-original-version-number)
+ 'face `(variable-pitch :background ,bg :foreground ,fg)))
+ (let ((fill-column (window-width)))
+ (center-region (point-min) (point)))
+ (let ((size (image-size image)))
+ (insert-char ?\n (max 1 (round (- (window-height)
+ (or y (cdr size))) 2)))
+ (insert
+ (propertize " " 'display
+ `(space :align-to
+ ,(max 0 (round (- (window-width)
+ (or x (car size))) 2)))))
+ (insert-image image))
+ (setq gnus-simple-splash nil)
+ t))))
+ (t
+ (insert "
_ ___ _ _
_ ___ __ ___ __ _ ___
__ _ ___ __ ___
__
"
- ""))
- ;; And then hack it.
- (gnus-indent-rigidly (point-min) (point-max)
- (/ (max (- (window-width) (or x 46)) 0) 2))
- (goto-char (point-min))
- (forward-line 1)
- (let* ((pheight (count-lines (point-min) (point-max)))
- (wheight (window-height))
- (rest (- wheight pheight)))
- (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
- ;; Fontify some.
- (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
+ )
+ (goto-char (point-min))
+ (insert gnus-product-name " " gnus-version-number
+ (if (zerop (string-to-number gnus-revision-number))
+ ""
+ (concat " (r" gnus-revision-number ")"))
+ " based on " gnus-original-product-name " v"
+ gnus-original-version-number)
+ (insert-char ?\ (prog1
+ (max 0 (/ (- (window-width) (point)) 2))
+ (goto-char (point-min))))
+ (forward-line 1)
+ ;; And then hack it.
+ (gnus-indent-rigidly (point) (point-max)
+ (/ (max (- (window-width) (or x 46)) 0) 2))
+ (goto-char (point-min))
+ (forward-line 1)
+ (let* ((pheight (count-lines (point-min) (point-max)))
+ (wheight (window-height))
+ (rest (- wheight pheight)))
+ (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
+ ;; Fontify some.
+ (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
+ (setq gnus-simple-splash t)))
(goto-char (point-min))
(setq mode-line-buffer-identification (concat " " gnus-version))
- (setq gnus-simple-splash t)
(set-buffer-modified-p t))
(eval-when (load)
;;; Do the rest.
-(require 'custom)
(require 'gnus-util)
(require 'nnheader)
(kill-buffer (current-buffer))))))))
(defcustom gnus-select-method
- (ignore-errors
- (nconc
- (list 'nntp (or (ignore-errors
- (gnus-getenv-nntpserver))
- (when (and gnus-default-nntp-server
- (not (string= gnus-default-nntp-server "")))
- gnus-default-nntp-server)
- "news"))
- (if (or (null gnus-nntp-service)
- (equal gnus-nntp-service "nntp"))
- nil
- (list gnus-nntp-service))))
- "*Default method for selecting a newsgroup.
+ (condition-case nil
+ (nconc
+ (list 'nntp (or (condition-case nil
+ (gnus-getenv-nntpserver)
+ (error nil))
+ (when (and gnus-default-nntp-server
+ (not (string= gnus-default-nntp-server "")))
+ gnus-default-nntp-server)
+ "news"))
+ (if (or (null gnus-nntp-service)
+ (equal gnus-nntp-service "nntp"))
+ nil
+ (list gnus-nntp-service)))
+ (error nil))
+ "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.
:type 'gnus-select-method)
(defcustom gnus-message-archive-method
- `(nnfolder
- "archive"
- (nnfolder-directory ,(nnheader-concat message-directory "archive"))
- (nnfolder-active-file
- ,(nnheader-concat message-directory "archive/active"))
- (nnfolder-get-new-mail nil)
- (nnfolder-inhibit-expiry t))
+ (progn
+ ;; Don't require it at top level to avoid circularity.
+ (require 'message)
+ `(nnfolder
+ "archive"
+ (nnfolder-directory ,(nnheader-concat message-directory "archive"))
+ (nnfolder-active-file
+ ,(nnheader-concat message-directory "archive/active"))
+ (nnfolder-get-new-mail nil)
+ (nnfolder-inhibit-expiry t)))
"*Method used for archiving messages you've sent.
This should be a mail method.
-It's probably not a very effective to change this variable once you've
+It's probably not very effective to change this variable once you've
run Gnus once. After doing that, you must edit this server from the
server buffer."
:group 'gnus-server
you could set this variable:
\(setq gnus-secondary-select-methods '((nnml \"\")))"
-:group 'gnus-server
-:type '(repeat gnus-select-method))
+ :group 'gnus-server
+ :type '(repeat gnus-select-method))
(defvar gnus-backup-default-subscribed-newsgroups
'("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
nntp method, you might get acceptable results.
The value of this variable must be a valid select method as discussed
-in the documentation of `gnus-select-method'."
+in the documentation of `gnus-select-method'.
+
+It can also be a list of select methods, as well as the special symbol
+`current', which means to use the current select method. If it is a
+list, Gnus will try all the methods in the list until it finds a match."
:group 'gnus-server
:type '(choice (const :tag "default" nil)
- gnus-select-method))
+ (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews)))
+ gnus-select-method
+ (repeat :menu-tag "Try multiple"
+ :tag "Multiple"
+ :value (current (nnweb "refer" (nnweb-type dejanews)))
+ (choice :tag "Method"
+ (const current)
+ (const :tag "DejaNews"
+ (nnweb "refer" (nnweb-type dejanews)))
+ gnus-select-method))))
(defcustom gnus-group-faq-directory
'("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-asynchronous nil
- "*If non-nil, Gnus will supply backends with data needed for async article fetching."
- :group 'gnus-asynchronous
- :type 'boolean)
-
(defcustom gnus-large-newsgroup 200
"*The number of articles which indicates a large newsgroup.
If the number of articles in a newsgroup is greater than this value,
("nnfolder" mail respool address)
("nngateway" post-mail address prompt-address physical-address)
("nnweb" none)
+ ("nnslashdot" post)
+ ("nnultimate" none)
+ ("nnwfm" none)
+ ("nnwarchive" none)
("nnlistserv" none)
- ("nnagent" post-mail))
+ ("nnagent" post-mail)
+ ("nnimap" post-mail address prompt-address physical-address))
"*An alist of valid select methods.
The first element of each list lists should be a string with the name
of the select method. The other elements may be the category of
(const :format "%v " virtual)
(const respool)))))
-(define-widget 'gnus-select-method 'list
- "Widget for entering a select method."
- :args `((choice :tag "Method"
- ,@(mapcar (lambda (entry)
- (list 'const :format "%v\n"
- (intern (car entry))))
- gnus-valid-select-methods))
- (string :tag "Address")
- (editable-list :inline t
- (list :format "%v"
- variable
- (sexp :tag "Value")))))
+(defun gnus-redefine-select-method-widget ()
+ "Recomputes the select-method widget based on the value of
+`gnus-valid-select-methods'."
+ (define-widget 'gnus-select-method 'list
+ "Widget for entering a select method."
+ :value '(nntp "")
+ :tag "Select Method"
+ :args `((choice :tag "Method"
+ ,@(mapcar (lambda (entry)
+ (list 'const :format "%v\n"
+ (intern (car entry))))
+ gnus-valid-select-methods)
+ (symbol :tag "other"))
+ (string :tag "Address")
+ (repeat :tag "Options"
+ :inline t
+ (list :format "%v"
+ variable
+ (sexp :tag "Value"))))))
+
+(gnus-redefine-select-method-widget)
(defcustom gnus-updated-mode-lines '(group article summary tree)
"List of buffers that should update their mode lines.
:group 'gnus-visual
:type 'face)
-(defcustom gnus-article-display-hook
- (if (and (string-match "XEmacs" emacs-version)
- (featurep 'xface))
- '(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-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-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
\f
;;; Internal variables
+(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")
(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-agent nil
"Whether we want to use the Gnus agent or not.")
+(defvar gnus-agent-fetching nil
+ "Whether Gnus agent is in fetching mode.")
+
(defvar gnus-command-method nil
"Dynamically bound variable that says what the current backend is.")
(defvar gnus-have-read-active-file nil)
(defconst gnus-maintainer
- "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.")
+ "semi-gnus-ja@meadowy.org (T-gnus Bugfixing Girls + Boys)"
+ "The mail address of the T-gnus maintainers.")
(defcustom gnus-info-filename nil
"*Controls language of gnus Info.
(defvar gnus-variable-list
'(gnus-newsrc-options gnus-newsrc-options-n
- gnus-newsrc-last-checked-date
- gnus-newsrc-alist gnus-server-alist
- gnus-killed-list gnus-zombie-list
- gnus-topic-topology gnus-topic-alist
- gnus-format-specs)
+ gnus-newsrc-last-checked-date
+ gnus-newsrc-alist gnus-server-alist
+ gnus-killed-list gnus-zombie-list
+ gnus-topic-topology gnus-topic-alist)
"Gnus variables saved in the quick startup file.")
+(defvar gnus-product-variable-file-list
+ (let ((version (product-version (product-find 'gnus-vers)))
+ (codesys (static-if (boundp 'MULE) '*ctext* 'ctext)))
+ `(("strict-cache" ((product-version ,version) (emacs-version))
+ binary
+ gnus-format-specs-compiled)
+ ("cache" ((product-version ,version) (emacs-version))
+ ,codesys
+ gnus-format-specs)))
+ "Gnus variables are saved in the produce depend quick startup files.")
+
+(defcustom gnus-compile-user-specs t
+ "If non-nil, the user-defined format specs will be byte-compiled
+automatically.
+It has an effect on the values of `gnus-*-line-format-spec'."
+ :group 'gnus
+ :type 'boolean)
+
(defvar gnus-newsrc-alist nil
"Assoc list of read articles.
gnus-newsrc-hashtb should be kept so that both hold the same information.")
(defvar gnus-dead-summary nil)
+(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
+ "Regexp matching invalid groups.")
+
;;; End of variables.
;; Define some autoload functions Gnus might use.
(when (consp function)
(setq keymap (car (memq 'keymap function)))
(setq function (car function)))
- (autoload function (car package) nil interactive keymap)))
+ (unless (fboundp function)
+ (autoload function (car package) nil interactive keymap))))
(if (eq (nth 1 package) ':interactive)
- (cdddr package)
+ (nthcdr 3 package)
(cdr package)))))
- '(("info" Info-goto-node)
+ '(("info" :interactive t Info-goto-node)
("pp" pp pp-to-string pp-eval-expression)
("ps-print" ps-print-preprint)
- ("mail-extr" mail-extract-address-components)
- ("browse-url" browse-url)
+ ("browse-url" :interactive t browse-url)
("message" :interactive t
message-send-and-exit message-yank-original)
+ ("babel" babel-as-string)
("nnmail" nnmail-split-fancy nnmail-article-group)
("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
("rmailout" rmail-output rmail-output-to-rmail-file)
gnus-cache-possibly-remove-articles gnus-cache-request-article
gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
gnus-cache-enter-remove-article gnus-cached-article-p
- gnus-cache-open gnus-cache-close gnus-cache-update-article)
- ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
- gnus-cache-remove-article gnus-summary-insert-cached-articles)
- ("gnus-score" :interactive t
- gnus-summary-increase-score gnus-summary-set-score
- gnus-summary-raise-thread gnus-summary-raise-same-subject
- gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
- gnus-summary-lower-thread gnus-summary-lower-same-subject
- gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
- gnus-summary-current-score gnus-score-default
- gnus-score-flush-cache gnus-score-close
- gnus-possibly-score-headers gnus-score-followup-article
- gnus-score-followup-thread)
- ("gnus-score"
- (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
+ gnus-cache-open gnus-cache-close gnus-cache-update-article
+ gnus-cache-articles-in-group)
+ ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
+ gnus-cache-remove-article gnus-summary-insert-cached-articles)
+ ("gnus-score" :interactive t
+ gnus-summary-increase-score gnus-summary-set-score
+ gnus-summary-raise-thread gnus-summary-raise-same-subject
+ gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
+ gnus-summary-lower-thread gnus-summary-lower-same-subject
+ gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
+ gnus-summary-current-score gnus-score-delta-default
+ gnus-score-flush-cache gnus-score-close
+ gnus-possibly-score-headers gnus-score-followup-article
+ gnus-score-followup-thread)
+ ("gnus-score"
+ (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
gnus-current-score-file-nondirectory gnus-score-adaptive
gnus-score-find-trace gnus-score-file-name)
- ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
+ ("gnus-cus" :interactive t gnus-custom-mode gnus-group-customize
+ gnus-score-customize)
("gnus-topic" :interactive t gnus-topic-mode)
- ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters)
+ ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters
+ gnus-subscribe-topics)
("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
("gnus-uu" :interactive t
("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-article-mail gnus-copy-article-buffer gnus-following-method)
("gnus-msg" :interactive t
gnus-group-post-news gnus-group-mail gnus-summary-post-news
gnus-summary-followup gnus-summary-followup-with-original
gnus-summary-resend-message gnus-summary-resend-bounced-mail
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-summary-wide-reply-with-original gnus-summary-post-forward
+ gnus-summary-digest-mail-forward gnus-summary-digest-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-group-display-picons)
("gnus-picon" gnus-picons-buffer-name)
("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
gnus-grouplens-mode)
gnus-offer-save-summaries gnus-make-thread-indent-array
gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject
gnus-summary-skip-intangible gnus-summary-article-number
- gnus-data-header gnus-data-find)
+ gnus-data-header gnus-data-find gnus-summary-jump-to-other-group)
("gnus-group" gnus-group-insert-group-line gnus-group-quit
gnus-group-list-groups gnus-group-first-unread-group
gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
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-decode-HZ
+ gnus-article-wash-html
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-show-all-headers gnus-article-show-all
gnus-article-edit-mode gnus-article-edit-article
gnus-article-edit-done article-decode-encoded-words
- gnus-start-date-timer gnus-stop-date-timer)
+ gnus-start-date-timer gnus-stop-date-timer
+ gnus-article-toggle-headers)
("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)
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)
+ ("miee" :interactive t gnspool-get-news
+ mail-spool-send news-spool-post)
+ ("international/mw32misc" define-process-argument-editing
+ general-process-argument-editing-function)
("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
gnus-unplugged gnus-agentize gnus-agent-batch)
("gnus-vm" :interactive t gnus-summary-save-in-vm
gnus-summary-save-article-vm)
- ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts))))
+ ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts)
+ ("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
+ ("gnus-mlspl" :interactive t gnus-group-split-setup
+ gnus-group-split-update))))
+
+(eval-and-compile
+ (unless (featurep 'xemacs)
+ (if (>= emacs-major-version 21)
+ (autoload 'x-face-decode-message-header "x-face-e21")
+ (autoload 'gnus-smiley-display "gnus-bitmap" nil t)
+ (autoload 'smiley-toggle-buffer "gnus-bitmap")
+ (autoload 'x-face-mule-gnus-article-display-x-face "x-face-mule"))))
;;; gnus-sum.el thingies
(setq strings nil)))
string))
-(defun gnus-version (&optional arg)
- "Version number of this version of Gnus.
-If ARG, insert string at point."
- (interactive "P")
- (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)
- (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"
- (if (member alpha '("(ding)" "d"))
- "4.99"
- (+ 5 (* 0.02
- (abs
- (- (char-int (aref (downcase alpha) 0))
- (char-int ?t))))
- -0.01))
- minor least)
- (format "%d.%02d%02d" major minor least))))))
-
(defun gnus-info-find-node ()
"Find Info documentation of Gnus."
(interactive)
(or gnus-info-filename
(get-language-info current-language-environment 'gnus-info)
"gnus")
- (cadr (assq major-mode gnus-info-nodes))))
+ (or (cadr (assq major-mode gnus-info-nodes))
+ (and (eq (current-buffer) (get-buffer gnus-article-buffer))
+ (cadr (assq 'gnus-article-mode gnus-info-nodes))))))
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
out)
(cond
((= c ?r)
- (push (if (< (point) (mark) (point) (mark))) out)
- (push (if (> (point) (mark) (point) (mark))) out))))
+ (push (if (< (point) (mark)) (point) (mark)) out)
+ (push (if (> (point) (mark)) (point) (mark)) out))))
(setq out (delq 'gnus-prefix-nil out))
(nreverse out)))
"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 ()
(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)
(let ((methods gnus-secondary-select-methods)
(gmethod (gnus-server-get-method nil method)))
(while (and methods
- (not (gnus-method-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)))
+ (cond ((stringp method)
+ method)
+ ((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."
(when info
(gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
-;; Function written by Stainless Steel Rat <ratinox@peorth.gweep.net>
(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
(depth 0)
(skip 1)
(levels (or levels
+ gnus-group-uncollapsed-levels
(progn
(while (string-match "\\." group skip)
(setq skip (match-end 0)
depth (+ depth 1)))
depth))))
- ;; 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
- (let* ((colon (string-match ":" group))
+ ;; 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.
+ (let* ((colon (string-match ":" group))
(server (and colon (substring group 0 colon)))
- (plus (and server (string-match "+" server))))
+ (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))
- (setq name (concat name (substring group 0 1))
- group (substring group (match-end 0))
- levels (- levels 1)
- name (concat name "."))
- (setq name (concat foreign name group)
- group nil)))
- name))
+ (if plus
+ (setq foreign (substring server (+ 1 plus)
+ (string-match "\\." server))
+ group (substring group (+ 1 colon)))
+ (setq foreign server
+ group (substring group (+ 1 colon))))
+ (setq foreign (concat foreign ":")))
+ ;; Collapse group name leaving LEVELS uncollapsed elements
+ (let* ((slist (split-string group "/"))
+ (slen (length slist))
+ (dlist (split-string group "\\."))
+ (dlen (length dlist))
+ glist
+ glen
+ gsep
+ res)
+ (if (> slen dlen)
+ (setq glist slist
+ glen slen
+ gsep "/")
+ (setq glist dlist
+ glen dlen
+ gsep "."))
+ (setq levels (- glen levels))
+ (dolist (g glist)
+ (push (if (>= (decf levels) 0)
+ (if (zerop (length g))
+ ""
+ (substring g 0 1))
+ g)
+ res))
+ (concat foreign (mapconcat 'identity (nreverse res) gsep))))))
(defun gnus-narrow-to-body ()
"Narrow to the body of an article."
(let ((opened gnus-opened-servers))
(while (and method opened)
(when (and (equal (cadr method) (cadaar opened))
- (equal (car method) (caaar opened))
+ (equal (car method) (caaar opened))
(not (equal method (caar opened))))
(setq method nil))
(pop opened))
(or gnus-override-method
(and (not group)
gnus-select-method)
+ (and (not (gnus-group-entry group));; a new group
+ (gnus-group-name-to-method group))
(let ((info (or info (gnus-get-info group)))
method)
(if (or (not info)
(let ((prefix "")
group)
(while (not group)
- (when (string-match
- "[: `'\"/]\\|^$"
+ (when (string-match
+ gnus-invalid-group-regexp
(setq group (read-string (concat prefix prompt)
(cons (or default "") 0)
'gnus-group-history)))
Allow completion over sensible values."
(let* ((servers
(append gnus-valid-select-methods
+ (mapcar (lambda (i) (list (format "%s:%s" (caar i)
+ (cadar i))))
+ gnus-opened-servers)
gnus-predefined-server-alist
gnus-server-alist))
(method
((equal method "")
(setq method gnus-select-method))
((assoc method gnus-valid-select-methods)
- (list (intern method)
- (if (memq 'prompt-address
- (assoc method gnus-valid-select-methods))
- (read-string "Address: ")
- "")))
+ (let ((address (if (memq 'prompt-address
+ (assoc method gnus-valid-select-methods))
+ (read-string "Address: ")
+ "")))
+ (or (let ((opened gnus-opened-servers))
+ (while (and opened
+ (not (equal (format "%s:%s" method address)
+ (format "%s:%s" (caaar opened)
+ (cadaar opened)))))
+ (pop opened))
+ (caar opened))
+ (list (intern method) address))))
((assoc method servers)
method)
(t
(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)))
- (t
- (other-frame 1))))
- (gnus arg))
+ (static-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)
(gnus-ems-redefine)
-(provide 'gnus)
+(product-provide (provide 'gnus) 'gnus-vers)
;;; gnus.el ends here
projects / elisp / gnus.git- / blobdiff