(eval '(run-hooks 'gnus-load-hook))
+(eval-when-compile (require 'cl))
+
(require 'custom)
-(require 'gnus-load)
+(eval-and-compile
+ (if (< emacs-major-version 20)
+ (require 'gnus-load)))
(require 'message)
(defgroup gnus nil
:group 'gnus
:group 'faces)
+(defgroup gnus-agent nil
+ "Offline support for Gnus."
+ :group 'gnus)
+
(defgroup gnus-files nil
"Files used by Gnus."
:group 'gnus)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "5.4.60"
+(defconst gnus-version-number "0.18"
"Version number for this version of Gnus.")
-(defconst gnus-version (format "Gnus v%s" gnus-version-number)
+(defconst gnus-version (format "Quassia Gnus v%s" gnus-version-number)
"Version string for this version of Gnus.")
(defcustom gnus-inhibit-startup-message nil
(unless (featurep 'gnus-xmas)
(defalias 'gnus-make-overlay 'make-overlay)
+ (defalias 'gnus-delete-overlay 'delete-overlay)
(defalias 'gnus-overlay-put 'overlay-put)
(defalias 'gnus-move-overlay 'move-overlay)
(defalias 'gnus-overlay-end 'overlay-end)
(defalias 'gnus-extent-start-open 'ignore)
(defalias 'gnus-set-text-properties 'set-text-properties)
(defalias 'gnus-group-remove-excess-properties 'ignore)
- (defalias 'gnus-topic-remove-excess-properties 'ignore)
(defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
(defalias 'gnus-character-to-event 'identity)
(defalias 'gnus-put-text-property 'put-text-property)
(defalias 'gnus-mode-line-buffer-identification 'identity)
(defalias 'gnus-characterp 'numberp)
+ (defalias 'gnus-deactivate-mark 'deactivate-mark)
+ (defalias 'gnus-window-edges 'window-edges)
(defalias 'gnus-key-press-event-p 'numberp))
-;; 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")))
- (ignore-errors
- (set-face-foreground name fg)))
- (when (and bg
- (not (string-equal bg "default")))
- (ignore-errors
- (set-face-background name bg)))
- (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)))
- (ignore-errors
- (make-face-bold name)))
- (when (and italic
- (not (eq italic 'custom:asis)))
- (ignore-errors
- (make-face-italic name)))
- (when (and underline
- (not (eq underline 'custom:asis)))
- (ignore-errors
- (set-face-underline-p name t))))
- name))
-
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
(defface gnus-splash-face
'((((class color)
(background dark))
- (:foreground "red"))
+ (:foreground "ForestGreen"))
(((class color)
(background light))
- (:foreground "red"))
+ (:foreground "ForestGreen"))
(t
()))
"Level 1 newsgroup face.")
(defun gnus-splash ()
(save-excursion
- (switch-to-buffer gnus-group-buffer)
+ (switch-to-buffer (get-buffer-create gnus-group-buffer))
(let ((buffer-read-only nil))
(erase-buffer)
(unless gnus-inhibit-startup-message
(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)
- (system-name)))
+ "news"))
(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.
("nndraft" post-mail)
("nnfolder" mail respool address)
("nngateway" none address prompt-address physical-address)
- ("nnweb" none))
+ ("nnweb" none)
+ ("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
(checklist :inline t
(const :format "%v " address)
(const :format "%v " prompt-address)
+ (const :format "%v " physical-address)
(const :format "%v " virtual)
(const respool)))))
:group 'gnus-article-saving
:type 'directory)
+(defvar gnus-plugged t
+ "Whether Gnus is plugged or not.")
+
\f
;;; Internal variables
(defvar gnus-original-article-buffer " *Original Article*")
(defvar gnus-newsgroup-name nil)
+(defvar gnus-agent nil
+ "Whether we want to use the Gnus agent or not.")
+
+(defvar gnus-command-method nil
+ "Dynamically bound variable that says what the current backend is.")
+
(defvar gnus-current-select-method nil
"The current method for selecting a newsgroup.")
(expirable . expire) (killed . killed)
(bookmarks . bookmark) (dormant . dormant)
(scored . score) (saved . save)
- (cached . cache)))
+ (cached . cache) (downloadable . download)
+ (unsendable . unsend)))
(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
gnus-nocem-unwanted-article-p)
- ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
+ ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
+ gnus-server-server-name)
("gnus-srvr" gnus-browse-foreign-server)
("gnus-cite" :interactive t
gnus-article-highlight-citation gnus-article-hide-citation-maybe
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-decode-rfc1522 article-decode-rfc1522)
+ 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-async" gnus-async-request-fetched-article gnus-async-prefetch-next
gnus-async-prefetch-article gnus-async-prefetch-remove-group
gnus-async-halt-prefetch)
+ ("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" :interactive t
+ gnus-unplugged gnus-agentize)
("gnus-vm" :interactive t gnus-summary-save-in-vm
- gnus-summary-save-article-vm))))
+ gnus-summary-save-article-vm)
+ ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts))))
;;; gnus-sum.el thingies
%l GroupLens score (string).
%V Total thread score (number).
%P The line number (number).
+%O Download mark (character).
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
where X is the letter following %u. The function will be passed the
(defun gnus-suppress-keymap (keymap)
(suppress-keymap keymap)
- (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2
+ (let ((keys `([backspace] [delete] "\177" "\M-u"))) ;gnus-mouse-2
(while keys
(define-key keymap (pop keys) 'undefined))))
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
+;;;
+;;; gnus-interactive
+;;;
+
+(defvar gnus-current-prefix-symbol nil
+ "Current prefix symbol.")
+
+(defvar gnus-current-prefix-symbols nil
+ "List of current prefix symbols.")
+
+(defun gnus-interactive (string &optional params)
+ "Return a list that can be fed to `interactive'.
+See `interactive' for full documentation.
+
+Adds the following specs:
+
+y -- The current symbolic prefix.
+Y -- A list of the current symbolic prefix(es).
+A -- Article number.
+H -- Article header.
+g -- Group name."
+ (let ((i 0)
+ out c prompt)
+ (while (< i (length string))
+ (string-match ".\\([^\n]*\\)\n?" string i)
+ (setq c (aref string i))
+ (when (match-end 1)
+ (setq prompt (match-string 1 string)))
+ (setq i (match-end 0))
+ ;; We basically emulate just about everything that
+ ;; `interactive' does, but adds the "g" and "G" specs.
+ (push
+ (cond
+ ((= c ?a)
+ (completing-read prompt obarray 'fboundp t))
+ ((= c ?b)
+ (read-buffer prompt (current-buffer) t))
+ ((= c ?B)
+ (read-buffer prompt (other-buffer (current-buffer))))
+ ((= c ?c)
+ (read-char))
+ ((= c ?C)
+ (completing-read prompt obarray 'commandp t))
+ ((= c ?d)
+ (point))
+ ((= c ?D)
+ (read-file-name prompt nil default-directory 'lambda))
+ ((= c ?f)
+ (read-file-name prompt nil nil 'lambda))
+ ((= c ?F)
+ (read-file-name prompt))
+ ((= c ?k)
+ (read-key-sequence prompt))
+ ((= c ?K)
+ (error "Not implemented spec"))
+ ((= c ?e)
+ (error "Not implemented spec"))
+ ((= c ?m)
+ (mark))
+ ((= c ?N)
+ (error "Not implemented spec"))
+ ((= c ?n)
+ (string-to-number (read-from-minibuffer prompt)))
+ ((= c ?p)
+ (prefix-numeric-value current-prefix-arg))
+ ((= c ?P)
+ current-prefix-arg)
+ ((= c ?r)
+ 'gnus-prefix-nil)
+ ((= c ?s)
+ (read-string prompt))
+ ((= c ?S)
+ (intern (read-string prompt)))
+ ((= c ?v)
+ (read-variable prompt))
+ ((= c ?x)
+ (read-minibuffer prompt))
+ ((= c ?x)
+ (eval-minibuffer prompt))
+ ;; And here the new specs come.
+ ((= c ?y)
+ gnus-current-prefix-symbol)
+ ((= c ?Y)
+ gnus-current-prefix-symbols)
+ ((= c ?g)
+ (gnus-group-group-name))
+ ((= c ?A)
+ (gnus-summary-article-number))
+ ((= c ?H)
+ (gnus-summary-article-header))
+ (t
+ (error "Not implemented spec")))
+ out)
+ (cond
+ ((= c ?r)
+ (push (if (< (point) (mark) (point) (mark))) out)
+ (push (if (> (point) (mark) (point) (mark))) out))))
+ (setq out (delq 'gnus-prefix-nil out))
+ (nreverse out)))
+
+(defun gnus-symbolic-argument (&optional arg)
+ "Read a symbolic argument and a command, and then execute command."
+ (interactive "P")
+ (let* ((in-command (this-command-keys))
+ (command in-command)
+ gnus-current-prefix-symbols
+ gnus-current-prefix-symbol
+ syms)
+ (while (equal in-command command)
+ (message "%s-" (key-description (this-command-keys)))
+ (push (intern (char-to-string (read-char))) syms)
+ (setq command (read-key-sequence nil t)))
+ (setq gnus-current-prefix-symbols (nreverse syms)
+ gnus-current-prefix-symbol (car gnus-current-prefix-symbols))
+ (call-interactively (key-binding command t))))
+
;;; More various functions.
+(defsubst gnus-check-backend-function (func group)
+ "Check whether GROUP supports function FUNC.
+GROUP can either be a string (a group name) or a select method."
+ (ignore-errors
+ (let ((method (if (stringp group)
+ (car (gnus-find-method-for-group group))
+ group)))
+ (unless (featurep method)
+ (require method))
+ (fboundp (intern (format "%s-%s" method func))))))
+
(defun gnus-group-read-only-p (&optional group)
"Check whether GROUP supports editing or not.
If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note
(string-match gnus-total-expirable-newsgroups group)))))
(defun gnus-group-auto-expirable-p (group)
- "Check whether GROUP is total-expirable or not."
+ "Check whether GROUP is auto-expirable or not."
(let ((params (gnus-group-find-parameter group))
val)
(cond
(defun gnus-simplify-mode-line ()
"Make mode lines a bit simpler."
- (setq mode-line-modified "-- ")
+ (setq mode-line-modified (cdr gnus-mode-line-modified))
(when (listp mode-line-format)
(make-local-variable 'mode-line-format)
(setq mode-line-format (copy-sequence mode-line-format))
(defun gnus-group-prefixed-name (group method)
"Return the whole name from GROUP and METHOD."
(and (stringp method) (setq method (gnus-server-to-method method)))
- (if (not method)
+ (if (or (not method)
+ (gnus-server-equal method "native"))
group
(concat (format "%s" (car method))
(when (and
(setq methods (cdr methods)))
methods))
+(defun gnus-groups-from-server (server)
+ "Return a list of all groups that are fetched from SERVER."
+ (let ((alist (cdr gnus-newsrc-alist))
+ info groups)
+ (while (setq info (pop alist))
+ (when (gnus-server-equal (gnus-info-method info) server)
+ (push (gnus-info-group info) groups)))
+ (sort groups 'string<)))
+
(defun gnus-group-foreign-p (group)
"Say whether a group is foreign or not."
(and (not (gnus-group-native-p group))
(t
(gnus-server-add-address method)))))))
-(defsubst gnus-check-backend-function (func group)
- "Check whether GROUP supports function FUNC.
-GROUP can either be a string (a group name) or a select method."
- (ignore-errors
- (let ((method (if (stringp group)
- (car (gnus-find-method-for-group group))
- group)))
- (unless (featurep method)
- (require method))
- (fboundp (intern (format "%s-%s" method func))))))
-
(defun gnus-methods-using (feature)
"Find all methods that have FEATURE."
(let ((valids gnus-valid-select-methods)
projects / gnus / blobdiff