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
])
39 (autoload 'gnus-xmas-define
"gnus-xmas")
40 (autoload 'gnus-xmas-redefine
"gnus-xmas")
41 (autoload 'appt-select-lowest-window
"appt.el"))
43 (or (fboundp 'mail-file-babyl-p
)
44 (fset 'mail-file-babyl-p
'rmail-file-p
))
48 (defun gnus-mule-cite-add-face (number prefix face
)
49 ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
51 (let ((inhibit-point-motion-hooks t
)
55 (forward-char (chars-in-string prefix
))
56 (forward-char (length prefix
)))
57 (skip-chars-forward " \t")
60 (skip-chars-backward " \t")
63 (gnus-overlay-put (gnus-make-overlay from to
) 'face face
)))))
65 (defun gnus-mule-max-width-function (el max-width
)
66 (` (let* ((val (eval (, el
)))
67 (valstr (if (numberp val
)
68 (int-to-string val
) val
)))
69 (if (> (length valstr
) (, max-width
))
70 (truncate-string valstr
(, max-width
))
74 (if (string-match "XEmacs\\|Lucid" emacs-version
)
77 (defvar gnus-mouse-face-prop
'mouse-face
78 "Property used for highlighting mouse regions.")
80 (defvar gnus-article-x-face-command
81 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
82 "String or function to be executed to display an X-Face header.
83 If it is a string, the command will be executed in a sub-shell
84 asynchronously. The compressed face will be piped to this command."))
87 ((string-match "XEmacs\\|Lucid" emacs-version
)
90 ((or (not (boundp 'emacs-minor-version
))
91 (< emacs-minor-version
30))
92 ;; Remove the `intangible' prop.
93 (let ((props (and (boundp 'gnus-hidden-properties
)
94 gnus-hidden-properties
)))
95 (while (and props
(not (eq (car (cdr props
)) 'intangible
)))
96 (setq props
(cdr props
)))
98 (setcdr props
(cdr (cdr (cdr props
))))))
99 (unless (fboundp 'buffer-substring-no-properties
)
100 (defun buffer-substring-no-properties (beg end
)
101 (format "%s" (buffer-substring beg end
)))))
104 (provide 'gnusutil
))))
109 (defun gnus-dummy-func (&rest args
))
110 (let ((funcs '(mouse-set-point set-face-foreground
111 set-face-background x-popup-menu
)))
113 (unless (fboundp (car funcs
))
114 (fset (car funcs
) 'gnus-dummy-func
))
115 (setq funcs
(cdr funcs
))))))
116 (unless (fboundp 'file-regular-p
)
117 (defun file-regular-p (file)
118 (and (not (file-directory-p file
))
119 (not (file-symlink-p file
))
120 (file-exists-p file
))))
121 (unless (fboundp 'face-list
)
122 (defun face-list (&rest args
))))
125 (let ((case-fold-search t
))
127 ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type
))
128 (setq nnheader-file-name-translation-alist
129 (append nnheader-file-name-translation-alist
133 (defvar gnus-tmp-unread
)
134 (defvar gnus-tmp-replied
)
135 (defvar gnus-tmp-score-char
)
136 (defvar gnus-tmp-indentation
)
137 (defvar gnus-tmp-opening-bracket
)
138 (defvar gnus-tmp-lines
)
139 (defvar gnus-tmp-name
)
140 (defvar gnus-tmp-closing-bracket
)
141 (defvar gnus-tmp-subject-or-nil
)
143 (defun gnus-ems-redefine ()
145 ((string-match "XEmacs\\|Lucid" emacs-version
)
146 (gnus-xmas-redefine))
149 ;; Mule and new Emacs definitions
151 ;; [Note] Now there are three kinds of mule implementations,
152 ;; original MULE, XEmacs/mule and beta version of Emacs including
153 ;; some mule features. Unfortunately these API are different. In
154 ;; particular, Emacs (including original MULE) and XEmacs are
156 ;; Predicates to check are following:
157 ;; (boundp 'MULE) is t only if MULE (original; anything older than
158 ;; Mule 2.3) is running.
159 ;; (featurep 'mule) is t when every mule variants are running.
161 ;; These implementations may be able to share between original
162 ;; MULE and beta version of new Emacs. In addition, it is able to
163 ;; detect XEmacs/mule by (featurep 'mule) and to check variable
164 ;; `emacs-version'. In this case, implementation for XEmacs/mule
165 ;; may be able to share between XEmacs and XEmacs/mule.
167 (defalias 'gnus-truncate-string
'truncate-string
)
169 (defvar gnus-summary-display-table nil
170 "Display table used in summary mode buffers.")
171 (fset 'gnus-cite-add-face
'gnus-mule-cite-add-face
)
172 (fset 'gnus-max-width-function
'gnus-mule-max-width-function
)
173 (fset 'gnus-summary-set-display-table
'ignore
)
175 (when (boundp 'gnus-check-before-posting
)
176 (setq gnus-check-before-posting
178 (delq 'control-chars gnus-check-before-posting
))))
180 (defun gnus-summary-line-format-spec ()
181 (insert gnus-tmp-unread gnus-tmp-replied
182 gnus-tmp-score-char gnus-tmp-indentation
)
187 gnus-tmp-opening-bracket
190 (if (> (length gnus-tmp-name
) 20)
191 (truncate-string gnus-tmp-name
20)
193 gnus-tmp-closing-bracket
)
195 gnus-mouse-face-prop gnus-mouse-face
)
196 (insert " " gnus-tmp-subject-or-nil
"\n"))
199 (defun gnus-region-active-p ()
200 "Say whether the region is active."
201 (and (boundp 'transient-mark-mode
)
203 (boundp 'mark-active
)
209 ;; byte-compile-warnings: '(redefine callargs)
212 ;;; gnus-ems.el ends here