1 ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
3 ;; Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
29 (eval-when-compile (require 'cl))
31 ;;; Function aliases later to be redefined for XEmacs usage.
34 (defvar gnus-xemacs (string-match "XEmacs" emacs-version)
35 "Non-nil if running under XEmacs."))
37 (defvar gnus-mouse-2 [mouse-2])
38 (defvar gnus-down-mouse-3 [down-mouse-3])
39 (defvar gnus-down-mouse-2 [down-mouse-2])
40 (defvar gnus-widget-button-keymap nil)
41 (defvar gnus-mode-line-modified
43 (< emacs-major-version 20))
48 (autoload 'gnus-xmas-define "gnus-xmas")
49 (autoload 'gnus-xmas-redefine "gnus-xmas")
50 (autoload 'appt-select-lowest-window "appt"))
54 (defun gnus-mule-max-width-function (el max-width)
55 `(let* ((val (eval (, el)))
56 (valstr (if (numberp val)
57 (int-to-string val) val)))
58 (if (> (length valstr) ,max-width)
59 (truncate-string-to-width valstr ,max-width)
65 (defvar gnus-mouse-face-prop 'mouse-face
66 "Property used for highlighting mouse regions.")))
71 (defun gnus-dummy-func (&rest args))
72 (let ((funcs '(mouse-set-point set-face-foreground
73 set-face-background x-popup-menu)))
75 (unless (fboundp (car funcs))
76 (defalias (car funcs) 'gnus-dummy-func))
77 (setq funcs (cdr funcs)))))))
80 (let ((case-fold-search t))
82 ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32"
83 (symbol-name system-type))
84 (setq nnheader-file-name-translation-alist
85 (append nnheader-file-name-translation-alist
86 (mapcar (lambda (c) (cons c ?_))
87 '(?: ?* ?\" ?< ?> ??))
90 (defvar gnus-tmp-unread)
91 (defvar gnus-tmp-replied)
92 (defvar gnus-tmp-score-char)
93 (defvar gnus-tmp-indentation)
94 (defvar gnus-tmp-opening-bracket)
95 (defvar gnus-tmp-lines)
96 (defvar gnus-tmp-name)
97 (defvar gnus-tmp-closing-bracket)
98 (defvar gnus-tmp-subject-or-nil)
100 (defun gnus-ems-redefine ()
103 (gnus-xmas-redefine))
106 ;; Mule and new Emacs definitions
108 ;; [Note] Now there are three kinds of mule implementations,
109 ;; original MULE, XEmacs/mule and Emacs 20+ including
110 ;; MULE features. Unfortunately these API are different. In
111 ;; particular, Emacs (including original MULE) and XEmacs are
112 ;; quite different. Howvere, this version of Gnus doesn't support
113 ;; anything other than XEmacs 20+ and Emacs 20.3+.
115 ;; Predicates to check are following:
116 ;; (boundp 'MULE) is t only if MULE (original; anything older than
117 ;; Mule 2.3) is running.
118 ;; (featurep 'mule) is t when every mule variants are running.
120 ;; It is possible to detect XEmacs/mule by (featurep 'mule) and
121 ;; checking `emacs-version'. In this case, the implementation for
122 ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule.
124 (defvar gnus-summary-display-table nil
125 "Display table used in summary mode buffers.")
126 (defalias 'gnus-max-width-function 'gnus-mule-max-width-function)
127 (defalias 'gnus-summary-set-display-table (lambda ()))
129 (when (boundp 'gnus-check-before-posting)
130 (setq gnus-check-before-posting
132 (delq 'control-chars gnus-check-before-posting))))
134 (defun gnus-summary-line-format-spec ()
135 (insert gnus-tmp-unread gnus-tmp-replied
136 gnus-tmp-score-char gnus-tmp-indentation)
141 gnus-tmp-opening-bracket
144 (if (> (length gnus-tmp-name) 20)
145 (truncate-string-to-width gnus-tmp-name 20)
147 gnus-tmp-closing-bracket)
149 gnus-mouse-face-prop gnus-mouse-face)
150 (insert " " gnus-tmp-subject-or-nil "\n")))))
152 (defun gnus-region-active-p ()
153 "Say whether the region is active."
154 (and (boundp 'transient-mark-mode)
156 (boundp 'mark-active)
159 (defun gnus-add-minor-mode (mode name map)
160 (if (fboundp 'add-minor-mode)
161 (add-minor-mode mode name map)
162 (set (make-local-variable mode) t)
163 (unless (assq mode minor-mode-alist)
164 (push `(,mode ,name) minor-mode-alist))
165 (unless (assq mode minor-mode-map-alist)
166 (push (cons mode map)
167 minor-mode-map-alist))))
169 (defun gnus-x-splash ()
170 "Show a splash screen using a pixmap in the current buffer."
171 (let ((dir (nnheader-find-etc-directory "gnus"))
172 pixmap file height beg i)
174 (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
175 (let ((buffer-read-only nil))
178 (file-exists-p (setq file (concat dir "x-splash"))))
180 (insert-file-contents file)
181 (goto-char (point-min))
183 (setq pixmap (read (current-buffer))))))
185 (unless (facep 'gnus-splash)
186 (make-face 'gnus-splash))
187 (setq height (/ (car pixmap) (frame-char-height))
188 width (/ (cadr pixmap) (frame-char-width)))
189 (set-face-foreground 'gnus-splash "Brown")
190 (set-face-stipple 'gnus-splash pixmap)
191 (insert-char ?\n (* (/ (window-height) 2 height) height))
194 (insert-char ? (* (/ (window-width) 2 width) width))
196 (insert-char ? width)
197 (set-text-properties beg (point) '(face gnus-splash))
200 (goto-char (point-min))
203 (defun gnus-article-display-xface (beg end)
204 "Display an XFace header from between BEG and END in the current article.
205 This requires support for XPM or XBM images in your Emacs and the
206 external programs `uncompface', `icontopbm' and either `ppmtoxpm' (for
207 XPM support) or `ppmtoxbm' (for XBM support). On a GNU/Linux system
208 these might be in packages with names like `compface' or `faces-xface'
209 and `netpbm' or `libgr-progs', for instance.
211 This function is for Emacs 21+. See `gnus-xmas-article-display-xface'
214 (let ((cur (current-buffer))
216 (when (and (fboundp 'image-type-available-p)
217 (cond ((image-type-available-p 'xpm) (setq type 'xpm))
218 ((image-type-available-p 'xbm) (setq type 'xbm))))
220 (insert-buffer-substring cur beg end)
221 (call-process-region (point-min) (point-max) "uncompface"
223 (goto-char (point-min))
224 (insert "/* Width=48, Height=48 */\n")
225 (and (eq 0 (call-process-region (point-min) (point-max) "icontopbm"
227 (eq 0 (call-process-region (point-min) (point-max)
232 (setq image (create-image (buffer-string) type t))))
234 (goto-char (point-min))
235 (re-search-forward "^From:" nil 'move)
236 (insert-image image " "))))))
241 ;; byte-compile-warnings: '(redefine callargs)
244 ;;; gnus-ems.el ends here