X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-ems.el;h=48afbf7eadd10c99855f85e74c8f428314c08ada;hb=fbea3cdb8acee18a6835a2258ed6d24244bcbea2;hp=1404cade9cc8a563a39f84015e125566d4f64184;hpb=2bdf225fa3e4e4606e4dc80cc84e7892b9280c62;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el
index 1404cad..48afbf7 100644
--- a/lisp/gnus-ems.el
+++ b/lisp/gnus-ems.el
@@ -1,5 +1,5 @@
 ;;; gnus-ems.el --- functions for making Semi-gnus work under different Emacsen
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         Tatsuya Ichikawa <t-ichi@niagara.shiojiri.ne.jp>
@@ -34,7 +34,9 @@
   "Non-nil if running under XEmacs.")
 
 (defvar gnus-mouse-2 [mouse-2])
+(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 gnus-xemacs
 	  (< emacs-major-version 20))
@@ -58,9 +60,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)
@@ -71,14 +71,6 @@
                 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."
@@ -129,12 +121,6 @@
   (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)
       nil
@@ -172,19 +158,12 @@
       (while funcs
 	(unless (fboundp (car funcs))
 	  (fset (car funcs) 'gnus-dummy-func))
-	(setq funcs (cdr funcs))))))
-  (unless (fboundp 'file-regular-p)
-    (defun file-regular-p (file)
-      (and (not (file-directory-p file))
-	   (not (file-symlink-p file))
-	   (file-exists-p file))))
-  (unless (fboundp 'face-list)
-    (defun face-list (&rest args))))
+	(setq funcs (cdr funcs)))))))
 
 (eval-and-compile
   (let ((case-fold-search t))
     (cond
-     ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type))
+     ((string-match "windows-nt\\|os/2\\|emx" (symbol-name system-type))
       (setq nnheader-file-name-translation-alist
 	    (append nnheader-file-name-translation-alist
 		    '((?: . ?_)
@@ -224,42 +203,68 @@
     ;; `emacs-version'. In this case, implementation for XEmacs/mule
     ;; may be able to share between XEmacs and XEmacs/mule.
 
-    (defalias 'gnus-truncate-string 'truncate-string)
-
     (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)
 
-    (and window-system
-	 (module-installed-p 'bitmap)
-	 (fset 'gnus-group-startup-message 'gnus-mule-group-startup-message))
+    (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 ()
@@ -272,6 +277,7 @@
 (defun gnus-add-minor-mode (mode name map)
   (if (fboundp 'add-minor-mode)
       (add-minor-mode mode name map)
+    (set (make-local-variable mode) t)
     (unless (assq mode minor-mode-alist)
       (push `(,mode ,name) minor-mode-alist))
     (unless (assq mode minor-mode-map-alist)
@@ -283,18 +289,17 @@
   (let ((dir (nnheader-find-etc-directory "gnus"))
 	pixmap file height beg i)
     (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)
 	(when (and dir
 		   (file-exists-p (setq file (concat dir "x-splash"))))
-	  (nnheader-temp-write nil
+	  (with-temp-file nil
 	    (insert-file-contents file)
 	    (goto-char (point-min))
 	    (ignore-errors
 	      (setq pixmap (read (current-buffer))))))
 	(when pixmap
-	  (erase-buffer)
 	  (unless (facep 'gnus-splash)
 	    (make-face 'gnus-splash))
 	  (setq height (/ (car pixmap) (frame-char-height))
@@ -304,7 +309,7 @@
 	  (insert-char ?\n (* (/ (window-height) 2 height) height))
 	  (setq i height)
 	  (while (> i 0)
-	    (insert-char ?  (* (+ (/ (window-width) 2 width) 1) width))
+	    (insert-char ?  (* (/ (window-width) 2 width) width))
 	    (setq beg (point))
 	    (insert-char ?  width)
 	    (set-text-properties beg (point) '(face gnus-splash))
@@ -313,6 +318,59 @@
 	  (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)))))
+
+(defun-maybe assoc-ignore-case (key alist)
+  "Like `assoc', but assumes KEY is a string and ignores case when comparing."
+  (setq key (downcase key))
+  (let (element)
+    (while (and alist (not element))
+      (if (equal key (downcase (car (car alist))))
+	  (setq element (car alist)))
+      (setq alist (cdr alist)))
+    element))
+
+
+;;; Language support staffs.
+
+(defvar-maybe current-language-environment "English"
+  "The language environment.")
+
+(defvar-maybe language-info-alist nil
+  "Alist of language environment definitions.")
+
+(defun-maybe get-language-info (lang-env key)
+  "Return information listed under KEY for language environment LANG-ENV."
+  (if (symbolp lang-env)
+      (setq lang-env (symbol-name lang-env)))
+  (let ((lang-slot (assoc-ignore-case lang-env language-info-alist)))
+    (if lang-slot
+	(cdr (assq key (cdr lang-slot))))))
+
+(defun-maybe set-language-info (lang-env key info)
+  "Modify part of the definition of language environment LANG-ENV."
+  (if (symbolp lang-env)
+      (setq lang-env (symbol-name lang-env)))
+  (let (lang-slot key-slot)
+    (setq lang-slot (assoc lang-env language-info-alist))
+    (if (null lang-slot)		; If no slot for the language, add it.
+	(setq lang-slot (list lang-env)
+	      language-info-alist (cons lang-slot language-info-alist)))
+    (setq key-slot (assq key lang-slot))
+    (if (null key-slot)			; If no slot for the key, add it.
+	(progn
+	  (setq key-slot (list key))
+	  (setcdr lang-slot (cons key-slot (cdr lang-slot)))))
+    (setcdr key-slot info)))
+
 (provide 'gnus-ems)
 
 ;; Local Variables: