;;; gnus.el --- a newsreader for GNU Emacs
-;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc.
+;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 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)Various Various")
:group 'gnus)
-(defgroup gnus-mime nil
- "Variables for controlling the Gnus MIME interface."
- :group 'gnus)
-
(defgroup gnus-exit nil
"Exiting gnus."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.98"
- "Version number for this version of Gnus.")
+(defconst gnus-product-name "Semi-gnus"
+ "Product name of this version of gnus.")
+
+(defconst gnus-version-number "6.9.2"
+ "Version number for this version of gnus.")
-(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
- "Version string for this version of Gnus.")
+(defconst gnus-version
+ (format "%s %s (based on Gnus 5.6.45; for SEMI 1.11, FLIM 1.12)"
+ gnus-product-name gnus-version-number)
+ "Version string for this version of gnus.")
(defcustom gnus-inhibit-startup-message nil
"If non-nil, the startup message will not be displayed.
:group 'gnus-start
:type 'boolean)
+;;; Kludges to help the transition from the old `custom.el'.
+
(unless (featurep 'gnus-xmas)
(defalias 'gnus-make-overlay 'make-overlay)
(defalias 'gnus-delete-overlay 'delete-overlay)
(defalias 'gnus-characterp 'numberp)
(defalias 'gnus-deactivate-mark 'deactivate-mark)
(defalias 'gnus-window-edges 'window-edges)
- (defalias 'gnus-key-press-event-p 'numberp)
- (defalias 'gnus-decode-rfc1522 'ignore))
+ (defalias 'gnus-key-press-event-p 'numberp))
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
()))
"Level 3 empty newsgroup face.")
-(defface gnus-group-news-4-face
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 4 newsgroup face.")
-
-(defface gnus-group-news-4-empty-face
- '((((class color)
- (background dark))
- ())
- (((class color)
- (background light))
- ())
- (t
- ()))
- "Level 4 empty newsgroup face.")
-
-(defface gnus-group-news-5-face
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 5 newsgroup face.")
-
-(defface gnus-group-news-5-empty-face
- '((((class color)
- (background dark))
- ())
- (((class color)
- (background light))
- ())
- (t
- ()))
- "Level 5 empty newsgroup face.")
-
-(defface gnus-group-news-6-face
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 6 newsgroup face.")
-
-(defface gnus-group-news-6-empty-face
- '((((class color)
- (background dark))
- ())
- (((class color)
- (background light))
- ())
- (t
- ()))
- "Level 6 empty newsgroup face.")
-
(defface gnus-group-news-low-face
'((((class color)
(background dark))
(defface gnus-splash-face
'((((class color)
(background dark))
- (:foreground "Brown"))
+ (:foreground "ForestGreen"))
(((class color)
(background light))
- (:foreground "Brown"))
+ (:foreground "ForestGreen"))
(t
()))
- "Face of the splash screen.")
+ "Level 1 newsgroup face.")
(defun gnus-splash ()
(save-excursion
:group 'gnus-files
:group 'gnus-server
:type 'file)
-
+
;; This function is used to check both the environment variable
;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
;; an nntp server name default.
(and (file-readable-p gnus-nntpserver-file)
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus nntp*"))
+ (buffer-disable-undo (current-buffer))
(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
- (ignore-errors
+ (condition-case nil
(nconc
- (list 'nntp (or (ignore-errors
- (gnus-getenv-nntpserver))
+ (list 'nntp (or (condition-case nil
+ (gnus-getenv-nntpserver)
+ (error nil))
(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))))
+ (list gnus-nntp-service)))
+ (error nil))
"*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.
\"nnml+private:mail.misc\", for instance."
:group 'gnus-message
:type '(choice (const :tag "none" nil)
- function
sexp
string))
: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 in a frame of their own."
+ "*If non-nil, display picons."
:group 'gnus-meta
:type 'boolean)
:group 'gnus-summary-format
:type '(radio (function-item gnus-extract-address-components)
(function-item mail-extract-address-components)
+ (function-item std11-extract-address-components)
(function :tag "Other")))
(defcustom gnus-carpal nil
("nngateway" post-mail address prompt-address physical-address)
("nnweb" none)
("nnlistserv" none)
- ("nnagent" post-mail)
- ("nnimap" post-mail address prompt-address physical-address))
+ ("nnagent" post-mail))
"*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
(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-levels
+ :group 'gnus-group-level
: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-summary-stop-page-breaking
+ ;; gnus-summary-caesar-message
+ ;; gnus-summary-verbose-headers
+ gnus-summary-toggle-mime
+ 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
-(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
(defvar gnus-original-article-buffer " *Original Article*")
(defvar gnus-newsgroup-name nil)
,(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)
"bugs@gnus.org (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
+(defconst semi-gnus-developers
+ "Semi-gnus Developers:
+ semi-gnus-en@meadow.scphys.kyoto-u.ac.jp (In English),\
+ semi-gnus-ja@meadow.scphys.kyoto-u.ac.jp (In Japanese);"
+ "The mail address of the Semi-gnus developers.")
+
+(defcustom gnus-info-filename nil
+ "*Controls language of gnus Info.
+If nil and current-language-environment is Japanese, go to gnus-ja.
+Otherwise go to corresponding Info.
+This variable can be nil, gnus or gnus-ja."
+ :group 'gnus-start
+ :type '(choice (const nil)
+ (const :tag "English" gnus)
+ (const :tag "Japanese" gnus-ja)))
+
(defvar gnus-info-nodes
- '((gnus-group-mode "(gnus)The Group Buffer")
- (gnus-summary-mode "(gnus)The Summary Buffer")
- (gnus-article-mode "(gnus)The Article Buffer")
- (gnus-server-mode "(gnus)The Server Buffer")
- (gnus-browse-mode "(gnus)Browse Foreign Server")
- (gnus-tree-mode "(gnus)Tree Display"))
+ '((gnus-group-mode "The Group Buffer")
+ (gnus-summary-mode "The Summary Buffer")
+ (gnus-article-mode "The Article Buffer")
+ (mime/viewer-mode "The Article Buffer")
+ (gnus-server-mode "The Server Buffer")
+ (gnus-browse-mode "Browse Foreign Server")
+ (gnus-tree-mode "Tree Display"))
"Alist of major modes and related Info nodes.")
(defvar gnus-group-buffer "*Group*")
(if (eq (nth 1 package) ':interactive)
(cdddr package)
(cdr package)))))
- '(("metamail" metamail-buffer)
- ("info" Info-goto-node)
+ '(("info" Info-goto-node)
+ ("hexl" hexl-hex-string-to-integer)
("pp" pp pp-to-string pp-eval-expression)
- ("qp" quoted-printable-decode-region quoted-printable-decode-string)
("ps-print" ps-print-preprint)
("mail-extr" mail-extract-address-components)
("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)
+ ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time)
("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
- ("rmailout" rmail-output rmail-output-to-rmail-file)
+ ("timezone" timezone-make-date-arpa-standard timezone-fix-time
+ timezone-make-sortable-date timezone-make-time-string)
+ ("rmailout" rmail-output)
("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
rmail-show-message rmail-summary-exists
rmail-select-summary rmail-update-summary)
gnus-article-hide-citation-in-followups)
("gnus-kill" gnus-kill gnus-apply-kill-file-internal
gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
- gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
+ gnus-execute gnus-expunge)
("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
gnus-cache-possibly-remove-articles gnus-cache-request-article
gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
gnus-uu-decode-binhex-view gnus-uu-unmark-thread
- gnus-uu-mark-over gnus-uu-post-news)
- ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread)
+ gnus-uu-mark-over gnus-uu-post-news gnus-uu-post-news)
+ ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh
+ gnus-uu-unmark-thread)
("gnus-msg" (gnus-summary-send-map keymap)
gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
("gnus-msg" :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-group-iterate gnus-group-group-name)
+ gnus-clear-inboxes-moved 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-treat-article)
+ gnus-article-delete-invisible-text gnus-hack-decode-rfc1522)
("gnus-art" :interactive t
gnus-article-hide-headers gnus-article-hide-boring-headers
- gnus-article-treat-overstrike
+ gnus-article-treat-overstrike gnus-article-word-wrap
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-article-display-x-face
+ gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp
gnus-article-hide-pem gnus-article-hide-signature
gnus-article-strip-leading-blank-lines gnus-article-date-local
gnus-article-date-original gnus-article-date-lapsed
gnus-article-show-all-headers
gnus-article-edit-mode gnus-article-edit-article
- gnus-article-edit-done gnus-article-decode-encoded-words
- gnus-start-date-timer gnus-stop-date-timer
- gnus-mime-view-all-parts)
+ gnus-article-edit-done gnus-decode-rfc1522 article-decode-rfc1522
+ gnus-start-date-timer gnus-stop-date-timer)
("gnus-int" gnus-request-type)
("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
gnus-dribble-enter gnus-read-init-file gnus-dribble-touch)
("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
gnus-async-prefetch-article gnus-async-prefetch-remove-group
gnus-async-halt-prefetch)
+ ("pop3-fma" :interactive t
+ pop3-fma-set-pop3-password)
("gnus-agent" gnus-open-agent gnus-agent-get-function
gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p
gnus-agent-get-undownloaded-list gnus-agent-fetch-session
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-mlspl" gnus-group-split gnus-group-split-fancy)
- ("gnus-mlspl" :interactive t gnus-group-split-setup
- gnus-group-split-update))))
+ ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts))))
;;; gnus-sum.el thingies
%a Extracted name of the poster (string)
%A Extracted address of the poster (string)
%F Contents of the From: header (string)
-%f Contents of the From: or To: headers (string)
%x Contents of the Xref: header (string)
%D Date of the article (string)
%d Date of the article (string) in DD-MMM format
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 invalid to have these specs after a variable-length spec. Well,
+it is illegal 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.
(define-key keymap (pop keys) 'undefined))))
(defvar gnus-article-mode-map
- (let ((keymap (make-sparse-keymap)))
+ (let ((keymap (make-keymap)))
(gnus-suppress-keymap keymap)
keymap))
(defvar gnus-summary-mode-map
(string-to-number
(if (zerop major)
(format "%s00%02d%02d"
- (if (member alpha '("(ding)" "d"))
- "4.99"
- (+ 5 (* 0.02
- (abs
- (- (mm-char-int (aref (downcase alpha) 0))
- (mm-char-int ?t))))
- -0.01))
+ (cond
+ ((member alpha '("(ding)" "d")) "4.99")
+ ((member alpha '("September" "s")) "5.01")
+ ((member alpha '("Red" "r")) "5.03")
+ ((member alpha '("Quassia" "q")) "5.05")
+ ((member alpha '("p")) "5.07")
+ ((member alpha '("o")) "5.09")
+ ((member alpha '("n")) "5.11"))
minor least)
(format "%d.%02d%02d" major minor least))))))
(interactive)
;; Enlarge info window if needed.
(let (gnus-info-buffer)
- (Info-goto-node (cadr (assq major-mode gnus-info-nodes)))
+ (Info-goto-node (format "(%s)%s"
+ (or gnus-info-filename
+ (get-language-info current-language-environment 'gnus-info)
+ "gnus")
+ (cadr (assq major-mode gnus-info-nodes))))
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
(not (equal server (format "%s:%s" (caaar opened)
(cadaar opened)))))
(pop 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))))
+ (caar opened))))
(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)
possible
(list backend server))))))
-(defsubst gnus-native-method-p (method)
- "Return whether METHOD is the native select method."
- (gnus-method-equal method gnus-select-method))
-
(defsubst gnus-secondary-method-p (method)
"Return whether METHOD is a secondary select method."
(let ((methods gnus-secondary-select-methods)
(gmethod (gnus-server-get-method nil method)))
(while (and methods
- (not (gnus-method-equal
- (gnus-server-get-method nil (car methods))
- gmethod)))
+ (not (equal (gnus-server-get-method nil (car methods))
+ gmethod)))
(setq methods (cdr methods)))
methods))
-(defun gnus-method-simplify (method)
- "Return the shortest uniquely identifying string or method for 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."
(let ((alist (cdr gnus-newsrc-alist))
(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))
- (server (and colon (substring group 0 colon)))
- (plus (and server (string-match "+" server))))
- (when server
- (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)
- (substring g 0 1)
- g)
- res))
- (concat foreign (mapconcat 'identity (nreverse res) "."))))))
-
+ ;; 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
+ (when (string-match ":" group)
+ (cond ((string-match "+" group)
+ (let* ((plus (string-match "+" group))
+ (colon (string-match ":" group (or plus 0)))
+ (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))
+ (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))
+
(defun gnus-narrow-to-body ()
"Narrow to the body of an article."
(narrow-to-region
(let ((opened gnus-opened-servers))
(while (and method opened)
(when (and (equal (cadr method) (cadaar opened))
- (equal (car method) (caaar opened))
(not (equal method (caar opened))))
(setq method nil))
(pop opened))
(defun gnus-read-group (prompt &optional default)
"Prompt the user for a group name.
-Disallow invalid group names."
+Disallow illegal 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 "Invalid group name: \"%s\". " group)
+ (setq prefix (format "Illegal group name: \"%s\". " group)
group nil)))
group))
(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))
projects / elisp / gnus.git- / blobdiff