X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus.el;h=33c1fdf39518da3c89fdade1ac2856ad27114295;hp=5d0298b1e30c69aba9b1e3c229675a7efcfeecc9;hb=3f8dcafe9860c534c8c066e6ddad362ea0aa0c7a;hpb=6864d4a16ce668d5673e248da5caf5ff4ba4dc22

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 5d0298b1e..33c1fdf39 100644
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -31,7 +31,9 @@
 (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
@@ -244,7 +246,7 @@ is restarted, and sometimes reloaded."
   :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)
@@ -266,6 +268,7 @@ be set in `.emacs' instead."
 
 (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)
@@ -280,47 +283,10 @@ be set in `.emacs' instead."
   (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.
 
@@ -640,17 +606,17 @@ be set in `.emacs' instead."
 (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
@@ -1177,6 +1143,7 @@ this variable.	I think."
 			(checklist :inline t
 				   (const :format "%v " address)
 				   (const :format "%v " prompt-address)
+				   (const :format "%v " physical-address)
 				   (const :format "%v " virtual)
 				   (const respool)))))
 
@@ -1395,6 +1362,9 @@ want."
   :group 'gnus-article-saving
   :type 'directory)
 
+(defvar gnus-plugged t
+  "Whether Gnus is plugged or not.")
+
 
 ;;; Internal variables
 
@@ -1681,7 +1651,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       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)
@@ -1697,7 +1668,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       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
@@ -1775,7 +1747,7 @@ This restriction may disappear in later versions of Gnus."
 
 (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))))
 
@@ -2014,6 +1986,122 @@ If ARG, insert string at point."
     (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)
@@ -2212,7 +2300,8 @@ that that variable is buffer-local to the summary buffers."
 (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