Modify for SEMI 1.11, FLIM 1.12.
[elisp/gnus.git-] / lisp / gnus.el
index 97e17bb..4e78d94 100644 (file)
@@ -3,6 +3,8 @@
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+;;     Yoshiki Hayashi <g740685@komaba.ecc.u-tokyo.ac.jp>
 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
@@ -245,6 +247,10 @@ is restarted, and sometimes reloaded."
   :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")
@@ -253,18 +259,18 @@ is restarted, and sometimes reloaded."
 (defconst gnus-product-name "T-gnus"
   "Product name of this version of gnus.")
 
-(defconst gnus-version-number "6.9.07"
+(defconst gnus-version-number "6.10.034"
   "Version number for this version of gnus.")
 
-(defconst gnus-original-version-number "0.13"
+(defconst gnus-original-version-number "0.48"
     "Version number for this version of Gnus.")
 
 (defconst gnus-original-product-name "Pterodactyl Gnus"
-    "Version number for this version of Gnus.")
+  "Product name of the original version of Gnus.")
 
 (defconst gnus-version
-  (format "%s %s (based on %s %s ; for SEMI 1.8, FLIM 1.8/1.9)"
-          gnus-product-name gnus-version-number
+  (format "%s %s (based on %s %s ; for SEMI 1.11, FLIM 1.12)"
+         gnus-product-name gnus-version-number
          gnus-original-product-name gnus-original-version-number)
   "Version string for this version of gnus.")
 
@@ -280,8 +286,6 @@ be set in `.emacs' instead."
   :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)
@@ -301,7 +305,9 @@ be set in `.emacs' instead."
   (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-key-press-event-p 'numberp)
+  (defalias 'gnus-annotation-in-region-p 'ignore)
+  (defalias 'gnus-decode-rfc1522 'ignore))
 
 ;; We define these group faces here to avoid the display
 ;; update forced when creating new faces.
@@ -372,6 +378,72 @@ be set in `.emacs' instead."
      ()))
   "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))
@@ -794,7 +866,6 @@ used to 899, you would say something along these lines:
       (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
@@ -1140,10 +1211,10 @@ commands will still require prompting."
 
 (defcustom gnus-extract-address-components 'gnus-extract-address-components
   "*Function for extracting address components from a From header.
-
-`gnus-extract-address-components' is a quite fast, and too simplistic.
-`mail-extract-address-components' works much better, but is slower.
-`std11-extract-address-components' also works better, and less slower."
+Two pre-defined function exist: `gnus-extract-address-components',
+which is the default, quite fast, and too simplistic solution, and
+`mail-extract-address-components', which works much better, but is
+slower."
   :group 'gnus-summary-format
   :type '(radio (function-item gnus-extract-address-components)
                (function-item mail-extract-address-components)
@@ -1358,15 +1429,11 @@ face."
 (defcustom gnus-article-display-hook
   (if (and (string-match "XEmacs" emacs-version)
           (featurep 'xface))
-;;    '(gnus-article-decode-charset    - comment out for Semi-gnus
-;;     gnus-article-decode-rfc1522     - comment out for Semi-gnus
       '(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-decode-charset    - comment out for Semi-gnus
-;;      gnus-article-decode-rfc1522    - comment out for Semi-gnus
     '(gnus-article-hide-headers-if-wanted
       gnus-article-hide-boring-headers
       gnus-article-treat-overstrike
@@ -1423,6 +1490,7 @@ want."
 \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)
@@ -1494,14 +1562,29 @@ want."
   "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")
-    (mime/viewer-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")
+    (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*")
@@ -1584,18 +1667,14 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
          (cdr package)))))
    '(("info" Info-goto-node)
      ("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)
+     ("rmailout" rmail-output rmail-output-to-rmail-file)
      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
       rmail-show-message)
      ("gnus-audio" :interactive t gnus-audio-play)
@@ -1627,7 +1706,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       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-execute gnus-expunge gnus-batch-kill gnus-batch-score)
      ("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
@@ -1665,7 +1744,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       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-mark-over 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)
@@ -1677,8 +1756,11 @@ 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-summary-wide-reply gnus-summary-followup-to-mail
+      gnus-summary-followup-to-mail-with-original gnus-bug
+      gnus-summary-wide-reply-with-original
+      gnus-summary-post-forward gnus-summary-wide-reply-with-original
+      gnus-summary-post-forward)
      ("gnus-picon" :interactive t gnus-article-display-picons
       gnus-group-display-picons gnus-picons-article-display-x-face
       gnus-picons-display-x-face)
@@ -1706,7 +1788,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       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-hack-decode-rfc1522)
+      gnus-article-delete-invisible-text)
      ("gnus-art" :interactive t
       gnus-article-hide-headers gnus-article-hide-boring-headers
       gnus-article-treat-overstrike gnus-article-word-wrap
@@ -1718,7 +1800,7 @@ 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 article-decode-encoded-words
       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
@@ -1734,6 +1816,19 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
      ("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-offline"
+      gnus-offline-setup)
+     ("gnus-offline" :interactive t
+      gnus-offline-toggle-plugged
+      gnus-offline-set-unplugged-state
+      gnus-offline-toggle-auto-hangup
+      gnus-offline-toggle-on/off-send-mail
+      gnus-offline-toggle-articles-to-fetch
+      gnus-offline-toggle-movemail-program
+      gnus-offline-set-interval-time
+      gnus-offline-agent-expire)
+     ("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
@@ -1760,6 +1855,7 @@ with some simple extensions.
 %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
@@ -1820,7 +1916,7 @@ This restriction may disappear in later versions of Gnus."
       (define-key keymap (pop keys) 'undefined))))
 
 (defvar gnus-article-mode-map
-  (let ((keymap (make-keymap)))
+  (let ((keymap (make-sparse-keymap)))
     (gnus-suppress-keymap keymap)
     keymap))
 (defvar gnus-summary-mode-map
@@ -2030,7 +2126,12 @@ If ARG, insert string at point."
   (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)))
 
@@ -2523,22 +2624,18 @@ just the host name."
     ;; 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)))))))
+    (let* ((colon  (string-match ":" group))
+          (server (and colon (substring group 0 colon)))
+          (plus   (and server (string-match "+" server))))
+      (when server
+       (cond (plus
+              (setq foreign (substring server (+ 1 plus)
+                                       (string-match "\\." server))
+                    group (substring group (+ 1 colon))))
+              (t
+               (setq foreign server
+                     group (substring group (+ 1 colon)))))
+       (setq foreign (concat foreign ":"))))
     ;; collapse group name leaving LEVELS uncollapsed elements
     (while group
       (if (and (string-match "\\." group) (> levels 0))