(eval '(run-hooks 'gnus-load-hook))
-(defconst gnus-version-number "0.1"
+(defconst gnus-version-number "0.9"
"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.")
-;;; Splash screen.
+(defvar gnus-inhibit-startup-message nil
+ "*If non-nil, the startup message will not be displayed.")
+
+;;; Internal variables
(defvar gnus-group-buffer "*Group*")
-(defvar gnus-inhibit-startup-message nil
- "*If non-nil, the startup message will not be displayed.")
+;;; Splash screen.
(defun gnus-splash ()
- (switch-to-buffer gnus-group-buffer)
- (let ((buffer-read-only nil))
- (erase-buffer)
- (unless gnus-inhibit-startup-message
- (gnus-group-startup-message)
- (sit-for 0))))
+ (save-excursion
+ (switch-to-buffer gnus-group-buffer)
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (unless gnus-inhibit-startup-message
+ (gnus-group-startup-message)
+ (sit-for 0)))))
(defun gnus-indent-rigidly (start end arg)
"Indent rigidly using only spaces and no tabs."
(save-restriction
(narrow-to-region start end)
(indent-rigidly start end arg)
+ ;; We translate tabs into spaces -- not everybody uses
+ ;; an 8-character tab.
(goto-char (point-min))
(while (search-forward "\t" nil t)
(replace-match " " t t)))))
(setq mode-line-buffer-identification gnus-version)
(set-buffer-modified-p t))
-;(unless (string-match "xemacs" (emacs-version))
- (gnus-splash)
-;)
+(eval-when (load)
+ (gnus-splash))
;;; Do the rest.
(defun gnus-alive-p ()
"Say whether Gnus is running or not."
(and gnus-group-buffer
- (get-buffer gnus-group-buffer)))
+ (get-buffer gnus-group-buffer)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (eq major-mode 'gnus-group-mode))))
;; Info access macros.
`(setcar (nthcdr 1 ,info) ,rank))
(defmacro gnus-info-set-read (info read)
`(setcar (nthcdr 2 ,info) ,read))
-(defmacro gnus-info-set-marks (info marks)
- `(setcar (nthcdr 3 ,info) ,marks))
-(defmacro gnus-info-set-method (info method)
- `(setcar (nthcdr 4 ,info) ,method))
-(defmacro gnus-info-set-params (info params)
- `(setcar (nthcdr 5 ,info) ,params))
+(defmacro gnus-info-set-marks (info marks &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,marks 3)
+ `(setcar (nthcdr 3 ,info) ,marks)))
+(defmacro gnus-info-set-method (info method &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,method 4)
+ `(setcar (nthcdr 4 ,info) ,method)))
+(defmacro gnus-info-set-params (info params &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,params 5)
+ `(setcar (nthcdr 5 ,info) ,params)))
+
+(defun gnus-info-set-entry (info entry number)
+ ;; Extend the info until we have enough elements.
+ (while (< (length info) number)
+ (nconc info (list nil)))
+ ;; Set the entry.
+ (setcar (nthcdr number info) entry))
(defmacro gnus-info-set-level (info level)
`(let ((rank (cdr ,info)))
(defmacro gnus-get-info (group)
`(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
+;; Byte-compiler warning.
+(defvar gnus-visual)
;; Find out whether the gnus-visual TYPE is wanted.
(defun gnus-visual-p (&optional type class)
(and gnus-visual ; Has to be non-nil, at least.
"Find Info documentation of Gnus."
(interactive)
;; Enlarge info window if needed.
- (let ((mode major-mode)
- gnus-info-buffer)
- (Info-goto-node (cadr (assq mode gnus-info-nodes)))
+ (let (gnus-info-buffer)
+ (Info-goto-node (cadr (assq major-mode gnus-info-nodes)))
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
(defun gnus-group-total-expirable-p (group)
"Check whether GROUP is total-expirable or not."
- (let ((params (gnus-info-params (gnus-get-info group))))
+ (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.
(defun gnus-group-auto-expirable-p (group)
"Check whether GROUP is total-expirable or not."
- (let ((params (gnus-info-params (gnus-get-info group))))
+ (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.
"Say whether the group is secondary or not."
(gnus-secondary-method-p (gnus-find-method-for-group group)))
+(defun gnus-group-find-parameter (group &optional symbol)
+ "Return the group parameters for GROUP.
+If SYMBOL, return the value of that symbol in the group parameters."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (let ((parameters (funcall gnus-group-get-parameter-function group)))
+ (if symbol
+ (gnus-group-parameter-value parameters symbol)
+ parameters))))
+
(defun gnus-group-get-parameter (group &optional symbol)
- "Returns the group parameters for GROUP.
+ "Return the group parameters for GROUP.
If SYMBOL, return the value of that symbol in the group parameters."
(let ((params (gnus-info-params (gnus-get-info group))))
(if symbol
(when info
(gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
-;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
+;; Function written by Stainless Steel Rat <ratinox@peorth.gweep.net>
(defun gnus-short-group-name (group &optional levels)
- "Collapse GROUP name LEVELS."
- (let* ((name "")
- (foreign "")
- (depth 0)
- (skip 1)
+ "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)
(levels (or 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
(if (string-match ":" group)
- (setq foreign (substring group 0 (match-end 0))
- group (substring group (match-end 0))))
+ (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 (- gnus-group-uncollapsed-levels 1)))
+ (if (and (string-match "\\." group) (> levels 0))
(setq name (concat name (substring group 0 1))
group (substring group (match-end 0))
levels (- levels 1)
group nil)))
name))
+
\f
;;;
;;; Kill file handling.
;; called "hello+alt.alt".
(let ((entry
(gnus-copy-sequence
- (if (equal (car method) "native") gnus-select-method
+ (if (gnus-server-equal method gnus-select-method) gnus-select-method
(cdr (assoc (car method) gnus-server-alist))))))
- (setcar (cdr entry) (concat (nth 1 entry) "+" group))
- (nconc entry (cdr method))))
+ (if (not entry)
+ method
+ (setcar (cdr entry) (concat (nth 1 entry) "+" group))
+ (nconc entry (cdr method)))))
(defun gnus-server-status (method)
"Return the status of METHOD."
(setq valids (cdr valids)))
outs))
+(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-server-alist)
+ nil t nil 'gnus-method-history)))
+ (cond
+ ((equal method "")
+ (setq method gnus-select-method))
+ ((assoc method gnus-valid-select-methods)
+ (list method
+ (if (memq 'prompt-address
+ (assoc method gnus-valid-select-methods))
+ (read-string "Address: ")
+ "")))
+ ((assoc method gnus-server-alist)
+ (list method))
+ (t
+ (list method "")))))
+
;;; User-level commands.
;;;###autoload
prompt the user for the name of an NNTP server to use.
As opposed to `gnus', this command will not connect to the local server."
(interactive "P")
- (let ((val (or arg (1- gnus-level-default-subscribed))))
- (gnus val t slave)
- (make-local-variable 'gnus-group-use-permanent-levels)
- (setq gnus-group-use-permanent-levels val)))
+ (gnus-no-server-1 arg slave))
;;;###autoload
(defun gnus-slave (&optional arg)
(select-frame (make-frame))
(gnus arg)))
+;;;###autoload
(defun gnus (&optional arg dont-connect slave)
"Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
projects / gnus / blobdiff