This commit was generated by cvs2svn to compensate for changes in r6200,
[elisp/gnus.git-] / lisp / gnus-ems.el
index f0e4362..f798e12 100644 (file)
@@ -1,7 +1,8 @@
-;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
+;;; gnus-ems.el --- functions for making Semi-gnus work under different Emacsen
 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;         Tatsuya Ichikawa <t-ichi@niagara.shiojiri.ne.jp>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -45,6 +46,9 @@
   (autoload 'gnus-xmas-redefine "gnus-xmas")
   (autoload 'appt-select-lowest-window "appt"))
 
+(or (fboundp 'mail-file-babyl-p)
+    (fset 'mail-file-babyl-p 'rmail-file-p))
+
 ;;; Mule functions.
 
 (defun gnus-mule-cite-add-face (number prefix face)
@@ -54,9 +58,7 @@
          from to)
       (goto-line number)
       (unless (eobp)            ; Sometimes things become confused (broken).
-        (if (boundp 'MULE)
-            (forward-char (chars-in-string prefix))
-          (forward-char (length prefix)))
+       (forward-char (chars-in-string prefix))
         (skip-chars-forward " \t")
         (setq from (point))
         (end-of-line 1)
                 gnus-cite-overlay-list)
           (gnus-overlay-put (gnus-make-overlay from to) 'face face))))))
 
-(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 valstr (, max-width))
-        valstr))))
+(defvar gnus-mule-bitmap-image-file nil)
+(defun gnus-mule-group-startup-message (&optional x y)
+  "Insert startup message in current buffer."
+  ;; Insert the message.
+  (erase-buffer)
+  (insert
+   (if (featurep 'bitmap)
+     (format "              %s
+
+"
+            "" (if (and (stringp gnus-mule-bitmap-image-file)
+                        (file-exists-p gnus-mule-bitmap-image-file))
+                   (insert-file gnus-mule-bitmap-image-file)))
+     (format "              %s
+          _    ___ _             _
+          _ ___ __ ___  __    _ ___
+          __   _     ___    __  ___
+              _           ___     _
+             _  _ __             _
+             ___   __            _
+                   __           _
+                    _      _   _
+                   _      _    _
+                      _  _    _
+                  __  ___
+                 _   _ _     _
+                _   _
+              _    _
+             _    _
+            _
+          __
+
+"
+            "")))
+  ;; And then hack it.
+  (gnus-indent-rigidly (point-min) (point-max)
+                      (/ (max (- (window-width) (or x 46)) 0) 2))
+  (goto-char (point-min))
+  (forward-line 1)
+  (let* ((pheight (count-lines (point-min) (point-max)))
+        (wheight (window-height))
+        (rest (- wheight pheight)))
+    (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
+  ;; Fontify some.
+  (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
+  (goto-char (point-min))
+  (setq mode-line-buffer-identification (concat " " gnus-version))
+  (setq gnus-simple-splash t)
+  (set-buffer-modified-p t))
+
+(defun gnus-encode-coding-string (string system)
+  string)
+
+(defun gnus-decode-coding-string (string system)
+  string)
 
 (eval-and-compile
   (if (string-match "XEmacs\\|Lucid" emacs-version)
    ((string-match "XEmacs\\|Lucid" emacs-version)
     (gnus-xmas-define))
 
+   ((or (not (boundp 'emacs-minor-version))
+       (and (< emacs-major-version 20)
+            (< emacs-minor-version 30)))
+    ;; Remove the `intangible' prop.
+    (let ((props (and (boundp 'gnus-hidden-properties)
+                     gnus-hidden-properties)))
+      (while (and props (not (eq (car (cdr props)) 'intangible)))
+       (setq props (cdr props)))
+      (when props
+       (setcdr props (cdr (cdr (cdr props))))))
+    (unless (fboundp 'buffer-substring-no-properties)
+      (defun buffer-substring-no-properties (beg end)
+       (format "%s" (buffer-substring beg end)))))
+
    ((boundp 'MULE)
     (provide 'gnusutil))))
 
 
     (defvar gnus-summary-display-table nil
       "Display table used in summary mode buffers.")
-    (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)
-    (fset 'gnus-max-width-function 'gnus-mule-max-width-function)
     (fset 'gnus-summary-set-display-table (lambda ()))
-    
+    (fset 'gnus-encode-coding-string 'encode-coding-string)
+    (fset 'gnus-decode-coding-string 'decode-coding-string)
+
+    (if (fboundp 'truncate-string-to-width)
+       (fset 'gnus-truncate-string 'truncate-string-to-width)
+      (fset 'gnus-truncate-string 'truncate-string))
+
+    (defun gnus-tilde-max-form (el max-width)
+      "Return a form that limits EL to MAX-WIDTH."
+      (let ((max (abs max-width)))
+       (if (symbolp el)
+           `(if (> (string-width ,el) ,max)
+                ,(if (< max-width 0)
+                     `(gnus-truncate-string
+                       ,el (string-width ,el)
+                       (- (string-width ,el) ,max))
+                   `(gnus-truncate-string ,el ,max))
+              ,el)
+         `(let ((val (eval ,el)))
+            (if (> (string-width val) ,max)
+                ,(if (< max-width 0)
+                     `(gnus-truncate-string
+                       val (string-width val)
+                       (- (string-width val) ,max))
+                   `(gnus-truncate-string val ,max))
+              val)))))
+
+    (defun gnus-tilde-cut-form (el cut-width)
+      "Return a form that cuts CUT-WIDTH off of EL."
+      (let ((cut (abs cut-width)))
+       (if (symbolp el)
+           `(if (> (string-width ,el) ,cut)
+                ,(if (< cut-width 0)
+                     `(gnus-truncate-string
+                       ,el (- (string-width ,el) ,cut))
+                   `(gnus-truncate-string
+                     ,el (- (string-width ,el) ,cut) ,cut))
+              ,el)
+         `(let ((val (eval ,el)))
+            (if (> (string-width val) ,cut)
+                ,(if (< cut-width 0)
+                     `(gnus-truncate-string
+                       val (- (string-width val) ,cut))
+                   `(gnus-truncate-string
+                     val (- (string-width val) ,cut) ,cut))
+              val)))))
+
+    (when window-system
+      (require 'path-util)
+      (if (module-installed-p 'bitmap)
+         (fset 'gnus-group-startup-message 'gnus-mule-group-startup-message)
+       ))
+
     (when (boundp 'gnus-check-before-posting)
       (setq gnus-check-before-posting
            (delq 'long-lines
                  (delq 'control-chars gnus-check-before-posting))))
 
-    (defun gnus-summary-line-format-spec ()
-      (insert gnus-tmp-unread gnus-tmp-replied
-             gnus-tmp-score-char gnus-tmp-indentation)
-      (put-text-property
-       (point)
-       (progn
-        (insert
-         gnus-tmp-opening-bracket
-         (format "%4d: %-20s"
-                 gnus-tmp-lines
-                 (if (> (length gnus-tmp-name) 20)
-                     (truncate-string gnus-tmp-name 20)
-                   gnus-tmp-name))
-         gnus-tmp-closing-bracket)
-        (point))
-       gnus-mouse-face-prop gnus-mouse-face)
-      (insert " " gnus-tmp-subject-or-nil "\n"))
+    (when (fboundp 'chars-in-string)
+      (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face))
+
     )))
 
 (defun gnus-region-active-p ()
        (erase-buffer)
        (when (and dir
                   (file-exists-p (setq file (concat dir "x-splash"))))
-         (with-temp-buffer
+         (nnheader-temp-write nil
            (insert-file-contents file)
            (goto-char (point-min))
            (ignore-errors
            (make-face 'gnus-splash))
          (setq height (/ (car pixmap) (frame-char-height))
                width (/ (cadr pixmap) (frame-char-width)))
-         (set-face-foreground 'gnus-splash "Brown")
+         (set-face-foreground 'gnus-splash "ForestGreen")
          (set-face-stipple 'gnus-splash pixmap)
          (insert-char ?\n (* (/ (window-height) 2 height) height))
          (setq i height)
          (goto-char (point-min))
          (sit-for 0))))))
 
+(if (fboundp 'split-string)
+    (fset 'gnus-split-string 'split-string)
+  (defun gnus-split-string (string pattern)
+    "Return a list of substrings of STRING which are separated by PATTERN."
+    (let (parts (start 0))
+      (while (string-match pattern string start)
+       (setq parts (cons (substring string start (match-beginning 0)) parts)
+             start (match-end 0)))
+      (nreverse (cons (substring string start) parts)))))
+
 (provide 'gnus-ems)
 
 ;; Local Variables: