;;; 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 <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(eval '(run-hooks 'gnus-load-hook))
(eval-when-compile (require 'cl))
+(require 'mm-util)
(require 'custom)
(eval-and-compile
: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)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.54"
+(defconst gnus-version-number "0.99"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
(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)
(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.
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-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)
("nnfolder" mail respool address)
("nngateway" post-mail address prompt-address physical-address)
("nnweb" none)
+ ("nnslashdot" post)
+ ("nnultimate" 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
(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"
(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.
: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-article-de-quoted-unreadable
- gnus-summary-stop-page-breaking
- ;; gnus-summary-caesar-message
- ;; gnus-summary-verbose-headers
- 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
(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)
+
\f
;;; Internal variables
,(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)
("browse-url" 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-score-find-trace gnus-score-file-name)
("gnus-cus" :interactive t 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-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)
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
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-hide-pgp
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))))
;;; gnus-sum.el thingies
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.
(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."
(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
+ (not (gnus-method-equal
(gnus-server-get-method nil (car methods))
gmethod)))
(setq methods (cdr 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* ((glist (split-string group "\\."))
+ (glen (length glist))
+ res)
+ (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) "."))))))
(defun gnus-narrow-to-body ()
"Narrow to the body of an article."
(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)
(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))
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
(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))