;;; 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>
(eval-when-compile (require 'cl))
(eval-when-compile (require 'static))
-(require 'custom)
(require 'gnus-vers)
-(eval-and-compile
- (if (< emacs-major-version 20)
- (require 'gnus-load)))
(require 'message)
(defgroup gnus nil
(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 100)
+ (:type xbm :file "gnus-pointer.xbm"
+ :ascent 100))))
+ 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)
"Insert startup message in current buffer."
;; Insert the message.
(erase-buffer)
- (insert "
+ (cond
+ ((and (fboundp 'find-image)
+ (display-graphic-p)
+ (let ((image
+ (find-image
+ `((:type xpm :file "gnus.xpm"
+ :color-symbols
+ (("thing" . "#724214")
+ ("shadow" . "#1e3f03")
+ ("background" . ,(face-background 'default))))
+ (:type xbm :file "gnus.xbm"
+ :foreground ,(face-foreground 'gnus-splash-face)
+ :background ,(face-background 'default))))))
+ (when image
+ (insert-image image)
+ (goto-char (point-min))
+ (insert-char
+ ?\ ;; space
+ (max 0 (let ((cw (frame-char-width)))
+ (/ (+ (- (* (window-width) cw) 271) cw) 2 cw))))
+ (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 "\n")
+ (goto-char (point-min))
+ (put-text-property (point) (gnus-point-at-eol)
+ 'face 'gnus-splash-face)
+ (insert-char ?\ ;; space
+ (max 0 (/ (- (window-width) (gnus-point-at-eol)) 2)))
+ (forward-line 1)
+ (insert-char
+ ?\n (max 0
+ (let ((ch (frame-char-height)))
+ (/ (+ (- (* (1- (window-height)) ch) 273) ch) 2 ch))))
+ (setq gnus-simple-splash nil)
+ t))))
+ (t
+ (insert "
_ ___ _ _
_ ___ __ ___ __ _ ___
__ _ ___ __ ___
__
"
- )
- (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)
- (goto-char (point-min))
- (insert-char ?\ ; space
- (max 0 (/ (- (window-width) (gnus-point-at-eol)) 2)))
- (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)
+ )
+ (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)
+ (goto-char (point-min))
+ (insert-char ?\ ; space
+ (max 0 (/ (- (window-width) (gnus-point-at-eol)) 2)))
+ (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)
nil
(list gnus-nntp-service)))
(error nil))
- "*Default method for selecting a newsgroup.
+ "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.
"*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
:type '(choice (const :tag "default" nil)
(const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews)))
gnus-select-method
- (repeat :menu-tag "Try multiple"
+ (repeat :menu-tag "Try multiple"
:tag "Multiple"
:value (current (nnweb "refer" (nnweb-type dejanews)))
(choice :tag "Method"
(const current)
- (const :tag "DejaNews"
+ (const :tag "DejaNews"
(nnweb "refer" (nnweb-type dejanews)))
gnus-select-method))))
: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,
(const :format "%v " virtual)
(const respool)))))
-(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))
- (string :tag "Address")
- (repeat :tag "Options"
- :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.
use the article treating faculties instead. Is is described in Info node
`Customizing Articles'.")
+(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)
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-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-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-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
"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 ()
(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)))
(or (let ((opened gnus-opened-servers))
(while (and opened
(not (equal (format "%s:%s" method address)
- (format "%s:%s" (caaar opened)
+ (format "%s:%s" (caaar opened)
(cadaar opened)))))
(pop opened))
(caar opened))