*** empty log message ***
[gnus] / lisp / gnus.el
index 3cbbb76..96bc400 100644 (file)
@@ -250,10 +250,10 @@ is restarted, and sometimes reloaded."
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 
-(defconst gnus-version-number "5.6.20"
+(defconst gnus-version-number "0.16"
   "Version number for this version of Gnus.")
 
-(defconst gnus-version (format "Gnus v%s" gnus-version-number)
+(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
   "Version string for this version of Gnus.")
 
 (defcustom gnus-inhibit-startup-message nil
@@ -600,6 +600,33 @@ be set in `.emacs' instead."
   "Face used for normal interest read articles.")
 
 
+;;;
+;;; Gnus buffers
+;;;
+
+(defvar gnus-buffers nil)
+
+(defun gnus-get-buffer-create (name)
+  "Do the same as `get-buffer-create', but store the created buffer."
+  (or (get-buffer name)
+      (car (push (get-buffer-create name) gnus-buffers))))
+
+(defun gnus-add-buffer ()
+  "Add the current buffer to the list of Gnus buffers."
+  (push (current-buffer) gnus-buffers))
+
+(defun gnus-buffers ()
+  "Return a list of live Gnus buffers."
+  (while (and gnus-buffers
+             (not (buffer-name (car gnus-buffers))))
+    (pop gnus-buffers))
+  (let ((buffers gnus-buffers))
+    (while (cdr buffers)
+      (if (buffer-name (cadr buffers))
+         (pop buffers)
+       (setcdr buffers (cddr buffers)))))
+  gnus-buffers)
+
 ;;; Splash screen.
 
 (defvar gnus-group-buffer "*Group*")
@@ -610,17 +637,17 @@ be set in `.emacs' instead."
 (defface gnus-splash-face
   '((((class color)
       (background dark))
-     (:foreground "ForestGreen"))
+     (:foreground "Brown"))
     (((class color)
       (background light))
-     (:foreground "ForestGreen"))
+     (:foreground "Brown"))
     (t
      ()))
-  "Level 1 newsgroup face.")
+  "Face of the splash screen.")
 
 (defun gnus-splash ()
   (save-excursion
-    (switch-to-buffer (get-buffer-create gnus-group-buffer))
+    (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
     (let ((buffer-read-only nil))
       (erase-buffer)
       (unless gnus-inhibit-startup-message
@@ -688,9 +715,10 @@ be set in `.emacs' instead."
 
 (eval-when (load)
   (let ((command (format "%s" this-command)))
-    (when (and (string-match "gnus" command)
-              (not (string-match "gnus-other-frame" command)))
-      (gnus-splash))))
+    (if (and (string-match "gnus" command)
+            (not (string-match "gnus-other-frame" command)))
+       (gnus-splash)
+      (gnus-get-buffer-create gnus-group-buffer))))
 
 ;;; Do the rest.
 
@@ -745,7 +773,7 @@ used to 899, you would say something along these lines:
   :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.
@@ -753,7 +781,7 @@ used to 899, you would say something along these lines:
   (or (getenv "NNTPSERVER")
       (and (file-readable-p gnus-nntpserver-file)
           (save-excursion
-            (set-buffer (get-buffer-create " *gnus nntp*"))
+            (set-buffer (gnus-get-buffer-create " *gnus nntp*"))
             (buffer-disable-undo (current-buffer))
             (insert-file-contents gnus-nntpserver-file)
             (let ((name (buffer-string)))
@@ -838,6 +866,7 @@ that case, just return a fully prefixed name of the group --
 \"nnml+private:mail.misc\", for instance."
   :group 'gnus-message
   :type '(choice (const :tag "none" nil)
+                sexp
                 string))
 
 (defcustom gnus-secondary-servers nil
@@ -1317,12 +1346,16 @@ face."
 (defcustom gnus-article-display-hook
   (if (and (string-match "XEmacs" emacs-version)
           (featurep 'xface))
-      '(gnus-article-hide-headers-if-wanted
+      '(gnus-article-decode-charset
+       gnus-article-decode-rfc1522
+       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-decode-charset
+      gnus-article-decode-rfc1522
+      gnus-article-hide-headers-if-wanted
       gnus-article-hide-boring-headers
       gnus-article-treat-overstrike
       gnus-article-maybe-highlight))
@@ -1419,11 +1452,11 @@ want."
 
 (defvar gnus-predefined-server-alist
   `(("cache"
-     (nnspool "cache"
-             (nnspool-spool-directory gnus-cache-directory)
-             (nnspool-nov-directory gnus-cache-directory)
-             (nnspool-active-file
-              (nnheader-concat gnus-cache-directory "active")))))
+     nnspool "cache"
+     (nnspool-spool-directory ,gnus-cache-directory)
+     (nnspool-nov-directory ,gnus-cache-directory)
+     (nnspool-active-file
+      ,(nnheader-concat gnus-cache-directory "active"))))
   "List of predefined (convenience) servers.")
 
 (defvar gnus-topic-indentation "") ;; Obsolete variable.
@@ -1465,9 +1498,6 @@ want."
 (defvar gnus-article-buffer "*Article*")
 (defvar gnus-server-buffer "*Server*")
 
-(defvar gnus-buffer-list nil
-  "Gnus buffers that should be killed on exit.")
-
 (defvar gnus-slave nil
   "Whether this Gnus is a slave or not.")
 
@@ -1543,20 +1573,21 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
          (cdr package)))))
    '(("metamail" metamail-buffer)
      ("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)
+     ("rfc2047" rfc2047-decode-region rfc2047-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)
-     ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time)
+     ("nnmail" nnmail-split-fancy nnmail-article-group)
      ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
      ("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-show-message rmail-output-to-rmail-file)
      ("gnus-audio" :interactive t gnus-audio-play)
      ("gnus-xmas" gnus-xmas-splash)
      ("gnus-soup" :interactive t
@@ -1623,8 +1654,10 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-uu-decode-binhex gnus-uu-decode-uu-view
       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" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh)
+      gnus-uu-decode-binhex-view gnus-uu-unmark-thread
+      gnus-uu-mark-over)
+     ("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
@@ -1634,6 +1667,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
       gnus-summary-mail-forward gnus-summary-mail-other-window
       gnus-summary-resend-message gnus-summary-resend-bounced-mail
+      gnus-summary-wide-reply
       gnus-bug)
      ("gnus-picon" :interactive t gnus-article-display-picons
       gnus-group-display-picons gnus-picons-article-display-x-face
@@ -1668,7 +1702,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       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-mime-decode-quoted-printable gnus-article-hide-pgp
+      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
@@ -1678,7 +1712,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       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-enter gnus-read-init-file gnus-dribble-touch)
      ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
       gnus-dup-enter-articles)
      ("gnus-range" gnus-copy-sequence)
@@ -1930,6 +1964,7 @@ This restriction may disappear in later versions of Gnus."
 ;;; Gnus Utility Functions
 ;;;
 
+
 (defmacro gnus-string-or (&rest strings)
   "Return the first element of STRINGS that is a non-blank string.
 STRINGS will be evaluated in normal `or' order."
@@ -1944,52 +1979,39 @@ STRINGS will be evaluated in normal `or' order."
        (setq strings nil)))
     string))
 
-;; Add the current buffer to the list of buffers to be killed on exit.
-(defun gnus-add-current-to-buffer-list ()
-  (or (memq (current-buffer) gnus-buffer-list)
-      (push (current-buffer) gnus-buffer-list)))
-
 (defun gnus-version (&optional arg)
   "Version number of this version of Gnus.
 If ARG, insert string at point."
   (interactive "P")
-  (let ((methods gnus-valid-select-methods)
-       (mess gnus-version)
-       meth)
-    ;; Go through all the legal select methods and add their version
-    ;; numbers to the total version string.  Only the backends that are
-    ;; currently in use will have their message numbers taken into
-    ;; consideration.
-    (while methods
-      (setq meth (intern (concat (caar methods) "-version")))
-      (and (boundp meth)
-          (stringp (symbol-value meth))
-          (setq mess (concat mess "; " (symbol-value meth))))
-      (setq methods (cdr methods)))
-    (if arg
-       (insert (message mess))
-      (message mess))))
+  (if arg
+      (insert (message gnus-version))
+    (message gnus-version)))
 
 (defun gnus-continuum-version (version)
   "Return VERSION as a floating point number."
   (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
            (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
-    (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
-          (number (match-string 2 version))
-          major minor least)
-      (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
-      (setq major (string-to-number (match-string 1 number)))
-      (setq minor (string-to-number (match-string 2 number)))
-      (setq least (if (match-beginning 3)
+    (let ((alpha (and (match-beginning 1) (match-string 1 version)))
+         (number (match-string 2 version))
+         major minor least)
+      (unless (string-match
+              "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
+       (error "Invalid version string: %s" version))
+      (setq major (string-to-number (match-string 1 number))
+           minor (string-to-number (match-string 2 number))
+           least (if (match-beginning 3)
                      (string-to-number (match-string 3 number))
                    0))
       (string-to-number
        (if (zerop major)
           (format "%s00%02d%02d"
-                  (cond
-                   ((member alpha '("(ding)" "d")) "4.99")
-                   ((member alpha '("September" "s")) "5.01")
-                   ((member alpha '("Red" "r")) "5.03"))
+                  (if (member alpha '("(ding)" "d"))
+                      "4.99"
+                    (+ 5 (* 0.02
+                            (abs
+                             (- (mm-char-int (aref (downcase alpha) 0))
+                                (mm-char-int ?t))))
+                       -0.01))
                   minor least)
         (format "%d.%02d%02d" major minor least))))))
 
@@ -2032,7 +2054,7 @@ g -- Group name."
        (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.
+      ;; `interactive' does, but add the specs listed above.
       (push
        (cond
        ((= c ?a)
@@ -2173,7 +2195,14 @@ that that variable is buffer-local to the summary buffers."
   "Return non-nil if GROUP (and ARTICLE) come from a news server."
   (or (gnus-member-of-valid 'post group) ; Ordinary news group.
       (and (gnus-member-of-valid 'post-mail group) ; Combined group.
-          (eq (gnus-request-type group article) 'news))))
+          (if (or (null article)
+                  (not (< article 0)))
+              (eq (gnus-request-type group article) 'news)
+            (if (not (vectorp article))
+                nil
+              ;; It's a real article.
+              (eq (gnus-request-type group (mail-header-id article))
+                  'news))))))
 
 ;; Returns a list of writable groups.
 (defun gnus-writable-groups ()
@@ -2242,9 +2271,11 @@ that that variable is buffer-local to the summary buffers."
         (gnus-server-to-method method))
        ((equal method gnus-select-method)
         gnus-select-method)
-       ((and (stringp (car method)) group)
+       ((and (stringp (car method))
+             group)
         (gnus-server-extend-method group method))
-       ((and method (not group)
+       ((and method
+             (not group)
              (equal (cadr method) ""))
         method)
        (t
@@ -2676,11 +2707,14 @@ Disallow illegal group names."
 (defun gnus-read-method (prompt)
   "Prompt the user for a method.
 Allow completion over sensible values."
-  (let ((method
-        (completing-read
-         prompt (append gnus-valid-select-methods gnus-predefined-server-alist
-                        gnus-server-alist)
-         nil t nil 'gnus-method-history)))
+  (let* ((servers
+         (append gnus-valid-select-methods
+                 gnus-predefined-server-alist
+                 gnus-server-alist))
+        (method
+         (completing-read
+          prompt servers
+          nil t nil 'gnus-method-history)))
     (cond
      ((equal method "")
       (setq method gnus-select-method))
@@ -2690,7 +2724,7 @@ Allow completion over sensible values."
                      (assoc method gnus-valid-select-methods))
                (read-string "Address: ")
              "")))
-     ((assoc method gnus-server-alist)
+     ((assoc method servers)
       method)
      (t
       (list (intern method) "")))))