1 ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
28 (eval-when-compile (require 'cl
))
30 ;;; Function aliases later to be redefined for XEmacs usage.
32 (defvar gnus-xemacs
(string-match "XEmacs\\|Lucid" emacs-version
)
33 "Non-nil if running under XEmacs.")
35 (defvar gnus-mouse-2
[mouse-2
])
36 (defvar gnus-down-mouse-2
[down-mouse-2
])
37 (defvar gnus-mode-line-modified
39 (< emacs-major-version
20))
44 (autoload 'gnus-xmas-define
"gnus-xmas")
45 (autoload 'gnus-xmas-redefine
"gnus-xmas")
46 (autoload 'appt-select-lowest-window
"appt"))
48 (or (fboundp 'mail-file-babyl-p
)
49 (fset 'mail-file-babyl-p
'rmail-file-p
))
53 (defun gnus-mule-cite-add-face (number prefix face
)
54 ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
56 (let ((inhibit-point-motion-hooks t
)
60 (forward-char (chars-in-string prefix
))
61 (forward-char (length prefix
)))
62 (skip-chars-forward " \t")
65 (skip-chars-backward " \t")
68 (gnus-overlay-put (gnus-make-overlay from to
) 'face face
)))))
70 (defun gnus-mule-max-width-function (el max-width
)
71 (` (let* ((val (eval (, el
)))
72 (valstr (if (numberp val
)
73 (int-to-string val
) val
)))
74 (if (> (length valstr
) (, max-width
))
75 (truncate-string valstr
(, max-width
))
78 (defun gnus-encode-coding-string (string system
)
82 (if (string-match "XEmacs\\|Lucid" emacs-version
)
85 (defvar gnus-mouse-face-prop
'mouse-face
86 "Property used for highlighting mouse regions."))
89 ((string-match "XEmacs\\|Lucid" emacs-version
)
92 ((or (not (boundp 'emacs-minor-version
))
93 (< emacs-minor-version
30))
94 ;; Remove the `intangible' prop.
95 (let ((props (and (boundp 'gnus-hidden-properties
)
96 gnus-hidden-properties
)))
97 (while (and props
(not (eq (car (cdr props
)) 'intangible
)))
98 (setq props
(cdr props
)))
100 (setcdr props
(cdr (cdr (cdr props
))))))
101 (unless (fboundp 'buffer-substring-no-properties
)
102 (defun buffer-substring-no-properties (beg end
)
103 (format "%s" (buffer-substring beg end
)))))
106 (provide 'gnusutil
))))
111 (defun gnus-dummy-func (&rest args
))
112 (let ((funcs '(mouse-set-point set-face-foreground
113 set-face-background x-popup-menu
)))
115 (unless (fboundp (car funcs
))
116 (fset (car funcs
) 'gnus-dummy-func
))
117 (setq funcs
(cdr funcs
))))))
118 (unless (fboundp 'file-regular-p
)
119 (defun file-regular-p (file)
120 (and (not (file-directory-p file
))
121 (not (file-symlink-p file
))
122 (file-exists-p file
))))
123 (unless (fboundp 'face-list
)
124 (defun face-list (&rest args
))))
127 (let ((case-fold-search t
))
129 ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type
))
130 (setq nnheader-file-name-translation-alist
131 (append nnheader-file-name-translation-alist
135 (defvar gnus-tmp-unread
)
136 (defvar gnus-tmp-replied
)
137 (defvar gnus-tmp-score-char
)
138 (defvar gnus-tmp-indentation
)
139 (defvar gnus-tmp-opening-bracket
)
140 (defvar gnus-tmp-lines
)
141 (defvar gnus-tmp-name
)
142 (defvar gnus-tmp-closing-bracket
)
143 (defvar gnus-tmp-subject-or-nil
)
145 (defun gnus-ems-redefine ()
147 ((string-match "XEmacs\\|Lucid" emacs-version
)
148 (gnus-xmas-redefine))
151 ;; Mule and new Emacs definitions
153 ;; [Note] Now there are three kinds of mule implementations,
154 ;; original MULE, XEmacs/mule and beta version of Emacs including
155 ;; some mule features. Unfortunately these API are different. In
156 ;; particular, Emacs (including original MULE) and XEmacs are
158 ;; Predicates to check are following:
159 ;; (boundp 'MULE) is t only if MULE (original; anything older than
160 ;; Mule 2.3) is running.
161 ;; (featurep 'mule) is t when every mule variants are running.
163 ;; These implementations may be able to share between original
164 ;; MULE and beta version of new Emacs. In addition, it is able to
165 ;; detect XEmacs/mule by (featurep 'mule) and to check variable
166 ;; `emacs-version'. In this case, implementation for XEmacs/mule
167 ;; may be able to share between XEmacs and XEmacs/mule.
169 (defalias 'gnus-truncate-string
'truncate-string
)
171 (defvar gnus-summary-display-table nil
172 "Display table used in summary mode buffers.")
173 (fset 'gnus-cite-add-face
'gnus-mule-cite-add-face
)
174 (fset 'gnus-max-width-function
'gnus-mule-max-width-function
)
175 (fset 'gnus-summary-set-display-table
'ignore
)
176 (fset 'gnus-encode-coding-string
'encode-coding-string
)
178 (when (boundp 'gnus-check-before-posting
)
179 (setq gnus-check-before-posting
181 (delq 'control-chars gnus-check-before-posting
))))
183 (defun gnus-summary-line-format-spec ()
184 (insert gnus-tmp-unread gnus-tmp-replied
185 gnus-tmp-score-char gnus-tmp-indentation
)
190 gnus-tmp-opening-bracket
193 (if (> (length gnus-tmp-name
) 20)
194 (truncate-string gnus-tmp-name
20)
196 gnus-tmp-closing-bracket
)
198 gnus-mouse-face-prop gnus-mouse-face
)
199 (insert " " gnus-tmp-subject-or-nil
"\n"))
202 (defun gnus-region-active-p ()
203 "Say whether the region is active."
204 (and (boundp 'transient-mark-mode
)
206 (boundp 'mark-active
)
209 (defun gnus-add-minor-mode (mode name map
)
210 (if (fboundp 'add-minor-mode
)
211 (add-minor-mode mode name map
)
212 (unless (assq mode minor-mode-alist
)
213 (push `(,mode
,name
) minor-mode-alist
))
214 (unless (assq mode minor-mode-map-alist
)
215 (push (cons mode map
)
216 minor-mode-map-alist
))))
221 ;; byte-compile-warnings: '(redefine callargs)
224 ;;; gnus-ems.el ends here