* gnus-agent.el (gnus-agentize): Updated documentation to match
[gnus] / lisp / gnus-ems.el
index f3dcec5..a9ab259 100644 (file)
@@ -1,7 +1,8 @@
 ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
 ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;;        Free Software Foundation, Inc.
 
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
 ;;; Code:
 
 
 ;;; Commentary:
 
 ;;; Code:
 
+(eval-when-compile
+  (require 'cl)
+  (require 'ring))
+
+;;; Function aliases later to be redefined for XEmacs usage.
+
 (defvar gnus-mouse-2 [mouse-2])
 (defvar gnus-mouse-2 [mouse-2])
-(defvar gnus-easymenu 'easymenu)
-(defvar gnus-group-mode-hook ())
-(defvar gnus-summary-mode-hook ())
-(defvar gnus-article-mode-hook ())
-
-(defalias 'gnus-make-overlay 'make-overlay)
-(defalias 'gnus-overlay-put 'overlay-put)
-(defalias 'gnus-move-overlay 'move-overlay)
-
-;; We do not byte-compile this file, because error messages are such a
-;; bore.  
-
-(eval
- '(progn
-    (if (string-match "XEmacs\\|Lucid" emacs-version)
-       ()
-      ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-      (defvar gnus-display-type 
-       (condition-case nil
-           (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
-             (cond (display-resource (intern (downcase display-resource)))
-                   ((x-display-color-p) 'color)
-                   ((x-display-grayscale-p) 'grayscale)
-                   (t 'mono)))
-         (error 'mono))
-       "A symbol indicating the display Emacs is running under.
-The symbol should be one of `color', `grayscale' or `mono'. If Emacs
-guesses this display attribute wrongly, either set this variable in
-your `~/.emacs' or set the resource `Emacs.displayType' in your
-`~/.Xdefaults'. See also `gnus-background-mode'.
-
-This is a meta-variable that will affect what default values other
-variables get.  You would normally not change this variable, but
-pounce directly on the real variables themselves.")
-
-      (defvar gnus-background-mode 
-       (condition-case nil
-           (let ((bg-resource (x-get-resource ".backgroundMode"
-                                              "BackgroundMode"))
-                 (params (frame-parameters)))
-             (cond (bg-resource (intern (downcase bg-resource)))
-                   ((and (cdr (assq 'background-color params))
-                         (< (apply '+ (x-color-values
-                                       (cdr (assq 'background-color params))))
-                            (/ (apply '+ (x-color-values "white")) 3)))
-                    'dark)
-                   (t 'light)))
-         (error 'light))
-       "A symbol indicating the Emacs background brightness.
-The symbol should be one of `light' or `dark'.
-If Emacs guesses this frame attribute wrongly, either set this variable in
-your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
-`~/.Xdefaults'.
-See also `gnus-display-type'.
-
-This is a meta-variable that will affect what default values other
-variables get.  You would normally not change this variable, but
-pounce directly on the real variables themselves."))
-
-    (cond 
-     ((string-match "XEmacs\\|Lucid" emacs-version)
-      ;; XEmacs definitions.
-
-      (setq gnus-mouse-2 [button2])
-      (setq gnus-easymenu 'auc-menu)
-
-      (or (memq 'underline (list-faces))
-         (funcall (intern "make-face") 'underline))
-      ;; Must avoid calling set-face-underline-p directly, because it
-      ;; is a defsubst in emacs19, and will make the .elc files non
-      ;; portable!
-      (or (face-differs-from-default-p 'underline)
-         (funcall 'set-face-underline-p 'underline t))
-      (or (fboundp 'set-text-properties)
-         (defun set-text-properties (start end props &optional buffer)
-           (if (or (null buffer) (bufferp buffer))
-               (if props
-                   (while props
-                     (put-text-property 
-                      start end (car props) (nth 1 props) buffer)
-                     (setq props (nthcdr 2 props)))
-                 (remove-text-properties start end ())))))
-
-      (defalias 'gnus-make-overlay 'make-extent)
-      (defalias 'gnus-overlay-put 'set-extent-property)
-      (defun gnus-move-overlay (extent start end &optional buffer)
-       (set-extent-endpoints extent start end))
-
-      (or (boundp 'standard-display-table) (setq standard-display-table nil))
-      (or (boundp 'read-event) (fset 'read-event 'next-command-event))
-
-      ;; Fix by "jeff (j.d.) sparkes" <jsparkes@bnr.ca>.
-      (defvar gnus-display-type (device-class)
-       "A symbol indicating the display Emacs is running under.
-The symbol should be one of `color', `grayscale' or `mono'. If Emacs
-guesses this display attribute wrongly, either set this variable in
-your `~/.emacs' or set the resource `Emacs.displayType' in your
-`~/.Xdefaults'. See also `gnus-background-mode'.
-
-This is a meta-variable that will affect what default values other
-variables get.  You would normally not change this variable, but
-pounce directly on the real variables themselves.")
-
-
-      (or (fboundp 'x-color-values)
-         (fset 'x-color-values 
-               (lambda (color)
-                 (color-instance-rgb-components
-                  (make-color-instance color)))))
-    
-      (defvar gnus-background-mode 
-       (let ((bg-resource 
-              (x-get-resource ".backgroundMode" "BackgroundMode" 'string))
-             (params (frame-parameters)))
-         (cond (bg-resource (intern (downcase bg-resource)))
-               ((and (assq 'background-color params)
-                     (< (apply '+ (x-color-values
-                                   (cdr (assq 'background-color params))))
-                        (/ (apply '+ (x-color-values "white")) 3)))
-                'dark)
-               (t 'light)))
-       "A symbol indicating the Emacs background brightness.
-The symbol should be one of `light' or `dark'.
-If Emacs guesses this frame attribute wrongly, either set this variable in
-your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
-`~/.Xdefaults'.
-See also `gnus-display-type'.
-
-This is a meta-variable that will affect what default values other
-variables get.  You would normally not change this variable, but
-pounce directly on the real variables themselves.")
-
-
-      (defun gnus-install-mouse-tracker ()
-       (require 'mode-motion)
-       (setq mode-motion-hook 'mode-motion-highlight-line)))
-
-     ((and (not (string-match "28.9" emacs-version)) 
-          (not (string-match "29" emacs-version)))
-      (setq gnus-hidden-properties '(invisible t))
-      (or (fboundp 'buffer-substring-no-properties)
-         (defun buffer-substring-no-properties (beg end)
-           (format "%s" (buffer-substring beg end)))))
-   
-     ((boundp 'MULE)
-      (provide 'gnusutil))
-   
-     )))
+(defvar gnus-down-mouse-3 [down-mouse-3])
+(defvar gnus-down-mouse-2 [down-mouse-2])
+(defvar gnus-widget-button-keymap nil)
+(defvar gnus-mode-line-modified
+  (if (or (featurep 'xemacs)
+         (< emacs-major-version 20))
+      '("--**-" . "-----")
+    '("**" "--")))
 
 (eval-and-compile
 
 (eval-and-compile
-  (cond
-   ((not window-system)
-    (defun gnus-dummy-func (&rest args))
-    (let ((funcs '(mouse-set-point set-face-foreground
-                                  set-face-background x-popup-menu)))
-      (while funcs
-       (or (fboundp (car funcs))
-           (fset (car funcs) 'gnus-dummy-func))
-       (setq funcs (cdr funcs))))))
-  (or (fboundp 'file-regular-p)
-      (defun file-regular-p (file)
-       (and (not (file-directory-p file))
-            (not (file-symlink-p file))
-            (file-exists-p file))))
-  (or (fboundp 'face-list)
-      (defun face-list (&rest args)))
-  )
+  (autoload 'gnus-xmas-define "gnus-xmas")
+  (autoload 'gnus-xmas-redefine "gnus-xmas")
+  (autoload 'appt-select-lowest-window "appt")
+  (autoload 'gnus-get-buffer-create "gnus")
+  (autoload 'nnheader-find-etc-directory "nnheader"))
+
+(autoload 'smiley-region "smiley")
+;; Fixme: shouldn't require message
+(autoload 'message-text-with-property "message")
+
+(defun gnus-kill-all-overlays ()
+  "Delete all overlays in the current buffer."
+  (let* ((overlayss (overlay-lists))
+        (buffer-read-only nil)
+        (overlays (delq nil (nconc (car overlayss) (cdr overlayss)))))
+    (while overlays
+      (delete-overlay (pop overlays)))))
+
+;;; Mule functions.
+
+(defun gnus-mule-max-width-function (el max-width)
+  `(let* ((val (eval (, el)))
+         (valstr (if (numberp val)
+                     (int-to-string val) val)))
+     (if (> (length valstr) ,max-width)
+        (truncate-string-to-width valstr ,max-width)
+       valstr)))
+
+(eval-and-compile
+  (defalias 'gnus-char-width
+    (if (fboundp 'char-width)
+       'char-width
+      (lambda (ch) 1)))) ;; A simple hack.
+
+(eval-and-compile
+  (if (featurep 'xemacs)
+      (gnus-xmas-define)
+    (defvar gnus-mouse-face-prop 'mouse-face
+      "Property used for highlighting mouse regions.")))
+
+(eval-when-compile
+  (defvar gnus-tmp-unread)
+  (defvar gnus-tmp-replied)
+  (defvar gnus-tmp-score-char)
+  (defvar gnus-tmp-indentation)
+  (defvar gnus-tmp-opening-bracket)
+  (defvar gnus-tmp-lines)
+  (defvar gnus-tmp-name)
+  (defvar gnus-tmp-closing-bracket)
+  (defvar gnus-tmp-subject-or-nil)
+  (defvar gnus-check-before-posting)
+  (defvar gnus-mouse-face)
+  (defvar gnus-group-buffer))
 
 (defun gnus-ems-redefine ()
 
 (defun gnus-ems-redefine ()
-  (cond 
-   ((string-match "XEmacs\\|Lucid" emacs-version)
-    ;; XEmacs definitions.
-    (fset 'gnus-mouse-face-function 'identity)
-    (fset 'gnus-summary-make-display-table (lambda () nil))
-    (fset 'gnus-visual-turn-off-edit-menu 'identity)
-
-    (defun gnus-highlight-selected-summary ()
-      ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-      ;; Highlight selected article in summary buffer
-      (if gnus-summary-selected-face
-         (save-excursion
-           (let* ((beg (progn (beginning-of-line) (point)))
-                  (end (progn (end-of-line) (point)))
-                  (to (max 1 (1- (or (previous-single-property-change
-                                      end 'mouse-face nil beg) end))))
-                  (from (1+ (or (next-single-property-change 
-                                 beg 'mouse-face nil end) beg))))
-             (if (< to beg)
-                 (progn
-                   (setq from beg)
-                   (setq to end)))
-             (if gnus-newsgroup-selected-overlay
-                 (delete-extent gnus-newsgroup-selected-overlay))
-             (setq gnus-newsgroup-selected-overlay
-                   (make-extent from to))
-             (set-extent-face gnus-newsgroup-selected-overlay
-                              gnus-summary-selected-face)))))
-
-
-    (defun gnus-summary-recenter ()
-      (let* ((top (cond ((< (window-height) 4) 0)
-                       ((< (window-height) 7) 1)
-                       (t 2)))
-            (height (- (window-height) 2))
-            (bottom (save-excursion (goto-char (point-max))
-                                    (forward-line (- height))
-                                    (point)))
-            (window (get-buffer-window (current-buffer))))
-       (and 
-        ;; The user has to want it,
-        gnus-auto-center-summary