(eval '(run-hooks 'gnus-load-hook))
-(defconst gnus-version-number "0.18"
+(require 'custom)
+
+(defgroup gnus nil
+ "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
+ :group 'emacs)
+
+(defgroup gnus-start nil
+ "Starting your favorite newsreader."
+ :group 'gnus)
+
+(defgroup gnus-score nil
+ "Score and kill file handling."
+ :group 'gnus )
+
+(defconst gnus-version-number "0.46"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
"Version string for this version of Gnus.")
-(defvar gnus-inhibit-startup-message nil
- "*If non-nil, the startup message will not be displayed.")
+(defcustom gnus-inhibit-startup-message nil
+ "*If non-nil, the startup message will not be displayed."
+ :group 'gnus-start
+ :type 'boolean)
+
+(defcustom gnus-play-startup-jingle nil
+ "If non-nil, play the Gnus jingle at startup."
+ :group 'gnus-start
+ :type 'boolean)
+
+;;; Kludges to help the transition from the old `custom.el'.
+
+;; XEmacs and Emacs 19.29 facep does different things.
+(defalias 'custom-facep
+ (cond ((fboundp 'find-face)
+ 'find-face)
+ ((fboundp 'facep)
+ 'facep)
+ (t
+ 'ignore)))
+
+;; The XEmacs people think this is evil, so it must go.
+(defun custom-face-lookup (&optional fg bg stipple bold italic underline)
+ "Lookup or create a face with specified attributes."
+ (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
+ (or fg "default")
+ (or bg "default")
+ (or stipple "default")
+ bold italic underline))))
+ (if (and (custom-facep name)
+ (fboundp 'make-face))
+ ()
+ (copy-face 'default name)
+ (when (and fg
+ (not (string-equal fg "default")))
+ (condition-case ()
+ (set-face-foreground name fg)
+ (error nil)))
+ (when (and bg
+ (not (string-equal bg "default")))
+ (condition-case ()
+ (set-face-background name bg)
+ (error nil)))
+ (when (and stipple
+ (not (string-equal stipple "default"))
+ (not (eq stipple 'custom:asis))
+ (fboundp 'set-face-stipple))
+ (set-face-stipple name stipple))
+ (when (and bold
+ (not (eq bold 'custom:asis)))
+ (condition-case ()
+ (make-face-bold name)
+ (error nil)))
+ (when (and italic
+ (not (eq italic 'custom:asis)))
+ (condition-case ()
+ (make-face-italic name)
+ (error nil)))
+ (when (and underline
+ (not (eq underline 'custom:asis)))
+ (condition-case ()
+ (set-face-underline-p name t)
+ (error nil))))
+ name))
;;; Internal variables
(defvar gnus-group-buffer "*Group*")
+(eval-and-compile
+ (autoload 'gnus-play-jingle "gnus-audio"))
+
;;; Splash screen.
(defun gnus-splash ()
(erase-buffer)
(unless gnus-inhibit-startup-message
(gnus-group-startup-message)
- (sit-for 0)))))
+ (sit-for 0)
+ (when gnus-play-startup-jingle
+ (gnus-play-jingle))))))
(defun gnus-indent-rigidly (start end arg)
"Indent rigidly using only spaces and no tabs."
(insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
;; Fontify some.
(goto-char (point-min))
- (and (search-forward "Praxis" nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
+ (when (search-forward "Praxis" nil t)
+ (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
(goto-char (point-min))
(setq mode-line-buffer-identification gnus-version)
(set-buffer-modified-p t))
(eval-when (load)
- (gnus-splash))
+ (let ((command (format "%s" this-command)))
+ (when (and (string-match "gnus" command)
+ (not (string-match "gnus-other-frame" command)))
+ (gnus-splash))))
;;; Do the rest.
;;; Load the compatability functions.
-(require 'gnus-cus)
(require 'gnus-ems)
\f
;; 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)
- (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
+ (push (current-buffer) gnus-buffer-list)))
(defun gnus-version (&optional arg)
"Version number of this version of Gnus.
(defun gnus-group-total-expirable-p (group)
"Check whether GROUP is total-expirable or not."
- (let ((params (gnus-group-find-parameter group)))
- (or (memq 'total-expire params)
- (cdr (assq 'total-expire params)) ; (total-expire . t)
- (and gnus-total-expirable-newsgroups ; Check var.
- (string-match gnus-total-expirable-newsgroups group)))))
+ (let ((params (gnus-group-find-parameter group))
+ val)
+ (cond
+ ((memq 'total-expire params)
+ t)
+ ((setq val (assq 'total-expire params)) ; (auto-expire . t)
+ (cdr val))
+ (gnus-total-expirable-newsgroups ; Check var.
+ (string-match gnus-total-expirable-newsgroups group)))))
(defun gnus-group-auto-expirable-p (group)
"Check whether GROUP is total-expirable or not."
- (let ((params (gnus-group-find-parameter group)))
- (or (memq 'auto-expire params)
- (cdr (assq 'auto-expire params)) ; (auto-expire . t)
- (and gnus-auto-expirable-newsgroups ; Check var.
- (string-match gnus-auto-expirable-newsgroups group)))))
+ (let ((params (gnus-group-find-parameter group))
+ val)
+ (cond
+ ((memq 'auto-expire params)
+ t)
+ ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
+ (cdr val))
+ (gnus-auto-expirable-newsgroups ; Check var.
+ (string-match gnus-auto-expirable-newsgroups group)))))
(defun gnus-virtual-group-p (group)
"Say whether GROUP is virtual or not."
"Return the quit-config of GROUP."
(gnus-group-get-parameter group 'quit-config))
+(defun gnus-kill-ephemeral-group (group)
+ "Remove ephemeral GROUP from relevant structures."
+ (gnus-sethash group nil gnus-newsrc-hashtb))
+
(defun gnus-simplify-mode-line ()
"Make mode lines a bit simpler."
(setq mode-line-modified "-- ")
(and (equal server "native") gnus-select-method)
;; It should be in the server alist.
(cdr (assoc server gnus-server-alist))
+ ;; It could be in the predefined server alist.
+ (cdr (assoc server gnus-predefined-server-alist))
;; If not, we look through all the opened server
;; to see whether we can find it there.
(let ((opened gnus-opened-servers))
(if (not method)
group
(concat (format "%s" (car method))
- (if (and
- (or (assoc (format "%s" (car method))
- (gnus-methods-using 'address))
- (gnus-server-equal method gnus-message-archive-method))
- (nth 1 method)
- (not (string= (nth 1 method) "")))
- (concat "+" (nth 1 method)))
+ (when (and
+ (or (assoc (format "%s" (car method))
+ (gnus-methods-using 'address))
+ (gnus-server-equal method gnus-message-archive-method))
+ (nth 1 method)
+ (not (string= (nth 1 method) "")))
+ (concat "+" (nth 1 method)))
":" group)))
(defun gnus-group-real-prefix (group)
"Add parameter PARAM to GROUP."
(let ((info (gnus-get-info group)))
(if (not info)
- () ; This is a dead group. We just ignore it.
+ () ; This is a dead group. We just ignore it.
;; Cons the new param to the old one and update.
(gnus-group-set-info (cons param (gnus-info-params info))
group 'params))))
"Set parameter NAME to VALUE in GROUP."
(let ((info (gnus-get-info group)))
(if (not info)
- () ; This is a dead group. We just ignore it.
+ () ; This is a dead group. We just ignore it.
(let ((old-params (gnus-info-params info))
(new-params (list (cons name value))))
(while old-params
- (if (or (not (listp (car old-params)))
- (not (eq (caar old-params) name)))
- (setq new-params (append new-params (list (car old-params)))))
+ (when (or (not (listp (car old-params)))
+ (not (eq (caar old-params) name)))
+ (setq new-params (append new-params (list (car old-params)))))
(setq old-params (cdr old-params)))
(gnus-group-set-info new-params group 'params)))))
;; 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
- (if (string-match ":" group)
- (cond ((string-match "+" group)
- (let* ((plus (string-match "+" group))
- (colon (string-match ":" group))
- (dot (string-match "\\." group)))
- (setq foreign (concat
- (substring group (+ 1 plus)
- (cond ((null dot) colon)
- ((< colon dot) colon)
- ((< dot colon) dot))) ":")
- group (substring group (+ 1 colon))
- )))
- (t
- (let* ((colon (string-match ":" group)))
- (setq foreign (concat (substring group 0 (+ 1 colon)))
- group (substring group (+ 1 colon)))
- ))))
+ (when (string-match ":" group)
+ (cond ((string-match "+" group)
+ (let* ((plus (string-match "+" group))
+ (colon (string-match ":" group))
+ (dot (string-match "\\." group)))
+ (setq foreign (concat
+ (substring group (+ 1 plus)
+ (cond ((null dot) colon)
+ ((< colon dot) colon)
+ ((< dot colon) dot)))
+ ":")
+ group (substring group (+ 1 colon))
+ )))
+ (t
+ (let* ((colon (string-match ":" group)))
+ (setq foreign (concat (substring group 0 (+ 1 colon)))
+ group (substring group (+ 1 colon)))
+ ))))
;; collapse group name leaving LEVELS uncollapsed elements
(while group
(if (and (string-match "\\." group) (> levels 0))
(when (get-file-buffer file)
(save-excursion
(set-buffer (get-file-buffer file))
- (and (buffer-modified-p) (save-buffer))
+ (when (buffer-modified-p)
+ (save-buffer))
(kill-buffer (current-buffer))))))
-(defvar gnus-kill-file-name "KILL"
- "Suffix of the kill files.")
+(defcustom gnus-kill-file-name "KILL"
+ "Suffix of the kill files."
+ :group 'gnus-score
+ :type 'string)
(defun gnus-newsgroup-kill-file (newsgroup)
"Return the name of a kill file name for NEWSGROUP.
(let ((valids gnus-valid-select-methods)
outs)
(while valids
- (if (memq feature (car valids))
- (setq outs (cons (car valids) outs)))
+ (when (memq feature (car valids))
+ (push (car valids) outs))
(setq valids (cdr valids)))
outs))
Allow completion over sensible values."
(let ((method
(completing-read
- prompt (append gnus-valid-select-methods gnus-server-alist)
+ prompt (append gnus-valid-select-methods gnus-predefined-server-alist
+ gnus-server-alist)
nil t nil 'gnus-method-history)))
(cond
((equal method "")
(defun gnus-other-frame (&optional arg)
"Pop up a frame to read news."
(interactive "P")
- (if (get-buffer gnus-group-buffer)
+ (if (gnus-alive-p)
(let ((pop-up-frames t))
(gnus arg))
(select-frame (make-frame))
projects / gnus / blobdiff