X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=b80cb48eb5640e45881949b4849b6fbb3c038c6f;hb=b19ab0bcf7b463d4b14b41bd23f2a5d62d03795a;hp=efaad9dff903fbe77e9c882193c66e2b84dbd40b;hpb=483d191790b7f8cf5ee888f0ac120b81b65b9580;p=gnus diff --git a/lisp/gnus.el b/lisp/gnus.el index efaad9dff..b80cb48eb 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -28,7 +28,7 @@ (eval '(run-hooks 'gnus-load-hook)) -(defconst gnus-version-number "0.5" +(defconst gnus-version-number "0.15" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) @@ -58,6 +58,8 @@ (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))))) @@ -132,6 +134,7 @@ (defmacro gnus-sethash (string value hashtable) "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." `(set (intern ,string ,hashtable) ,value)) +(put 'nnheader-temp-write 'edebug-form-spec '(form form form)) (defmacro gnus-group-unread (group) "Get the currently computed number of unread articles in GROUP." @@ -315,9 +318,8 @@ If ARG, insert string at point." "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))) @@ -332,7 +334,7 @@ that that variable is buffer-local to the summary buffers." (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. @@ -340,7 +342,7 @@ that that variable is buffer-local to the summary buffers." (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. @@ -557,8 +559,18 @@ that that variable is buffer-local to the summary buffers." "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 @@ -600,25 +612,41 @@ If SCORE is nil, add 1 to the score of GROUP." (when info (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) -;; Function written by Stainless Steel Rat . +;; Function written by Stainless Steel Rat (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) @@ -627,6 +655,7 @@ If SCORE is nil, add 1 to the score of GROUP." group nil))) name)) + ;;; ;;; Kill file handling. @@ -693,10 +722,12 @@ If NEWSGROUP is nil, return the global kill file name instead." ;; 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." @@ -764,15 +795,15 @@ Allow completion over sensible values." ((equal method "") (setq method gnus-select-method)) ((assoc method gnus-valid-select-methods) - (list method + (list (intern method) (if (memq 'prompt-address (assoc method gnus-valid-select-methods)) (read-string "Address: ") ""))) ((assoc method gnus-server-alist) - (list method)) + method) (t - (list method ""))))) + (list (intern method) ""))))) ;;; User-level commands. @@ -809,6 +840,7 @@ As opposed to `gnus', this command will not connect to the local server." (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