(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
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.8"
+(defconst gnus-version-number "0.18"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Quassia Gnus v%s" gnus-version-number)
(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-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 "green"))
+ (:foreground "ForestGreen"))
(((class color)
(background light))
- (:foreground "green"))
+ (: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
(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
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-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-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
(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)
(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
projects / gnus / blobdiff