Mercurial > emacs
annotate lisp/gnus/gnus-ems.el @ 32214:bc12cef85a10
Don't require cl.
(gnus-audio): New custom group.
(gnus-audio-inline-sound): Change to work with Emacs.
(gnus-audio-directory, gnus-audio-directory)
(gnus-audio-au-player): Customize.
(gnus-audio-play): Try external player if play-sound-file fails.
Use file-name-extension, not string-match.
author | Dave Love <fx@gnu.org> |
---|---|
date | Fri, 06 Oct 2000 14:35:13 +0000 |
parents | 6d8322cfbf71 |
children | 5b203c66fa7b |
rev | line source |
---|---|
17493 | 1 ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
3 ;; Free Software Foundation, Inc. |
17493 | 4 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
17493 | 6 ;; Keywords: news |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
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) | |
13 ;; any later version. | |
14 | |
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. | |
19 | |
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. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;;; Code: | |
28 | |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
29 (eval-when-compile |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
30 (require 'cl) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
31 (require 'ring)) |
17493 | 32 |
33 ;;; Function aliases later to be redefined for XEmacs usage. | |
34 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
35 (eval-and-compile |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
36 (defvar gnus-xemacs (featurep 'xemacs) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
37 "Non-nil if running under XEmacs.")) |
17493 | 38 |
39 (defvar gnus-mouse-2 [mouse-2]) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
40 (defvar gnus-down-mouse-3 [down-mouse-3]) |
17493 | 41 (defvar gnus-down-mouse-2 [down-mouse-2]) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
42 (defvar gnus-widget-button-keymap nil) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
43 (defvar gnus-mode-line-modified |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
44 (if (or gnus-xemacs |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
45 (< emacs-major-version 20)) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
46 '("--**-" . "-----") |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
47 '("**" "--"))) |
17493 | 48 |
49 (eval-and-compile | |
50 (autoload 'gnus-xmas-define "gnus-xmas") | |
51 (autoload 'gnus-xmas-redefine "gnus-xmas") | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
52 (autoload 'appt-select-lowest-window "appt")) |
17493 | 53 |
31780
d2b5643aab16
(gnus-smiley-display): Autoload from smiley-ems.
Dave Love <fx@gnu.org>
parents:
31767
diff
changeset
|
54 (autoload 'gnus-smiley-display "smiley-ems") ; override XEmacs version |
d2b5643aab16
(gnus-smiley-display): Autoload from smiley-ems.
Dave Love <fx@gnu.org>
parents:
31767
diff
changeset
|
55 |
17493 | 56 ;;; Mule functions. |
57 | |
58 (defun gnus-mule-max-width-function (el max-width) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
59 `(let* ((val (eval (, el))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
60 (valstr (if (numberp val) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
61 (int-to-string val) val))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
62 (if (> (length valstr) ,max-width) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
63 (truncate-string-to-width valstr ,max-width) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
64 valstr))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
65 |
17493 | 66 (eval-and-compile |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
67 (if gnus-xemacs |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
68 (gnus-xmas-define) |
17493 | 69 (defvar gnus-mouse-face-prop 'mouse-face |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
70 "Property used for highlighting mouse regions."))) |
17493 | 71 |
72 (eval-and-compile | |
73 (let ((case-fold-search t)) | |
74 (cond | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
75 ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32" |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
76 (symbol-name system-type)) |
17493 | 77 (setq nnheader-file-name-translation-alist |
78 (append nnheader-file-name-translation-alist | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
79 (mapcar (lambda (c) (cons c ?_)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
80 '(?: ?* ?\" ?< ?> ??)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
81 '((?+ . ?-)))))))) |
17493 | 82 |
83 (defvar gnus-tmp-unread) | |
84 (defvar gnus-tmp-replied) | |
85 (defvar gnus-tmp-score-char) | |
86 (defvar gnus-tmp-indentation) | |
87 (defvar gnus-tmp-opening-bracket) | |
88 (defvar gnus-tmp-lines) | |
89 (defvar gnus-tmp-name) | |
90 (defvar gnus-tmp-closing-bracket) | |
91 (defvar gnus-tmp-subject-or-nil) | |
92 | |
93 (defun gnus-ems-redefine () | |
94 (cond | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
95 (gnus-xemacs |
17493 | 96 (gnus-xmas-redefine)) |
97 | |
98 ((featurep 'mule) | |
99 ;; Mule and new Emacs definitions | |
100 | |
101 ;; [Note] Now there are three kinds of mule implementations, | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
102 ;; original MULE, XEmacs/mule and Emacs 20+ including |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
103 ;; MULE features. Unfortunately these API are different. In |
17493 | 104 ;; particular, Emacs (including original MULE) and XEmacs are |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
105 ;; quite different. Howvere, this version of Gnus doesn't support |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
106 ;; anything other than XEmacs 20+ and Emacs 20.3+. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
107 |
17493 | 108 ;; Predicates to check are following: |
109 ;; (boundp 'MULE) is t only if MULE (original; anything older than | |
110 ;; Mule 2.3) is running. | |
111 ;; (featurep 'mule) is t when every mule variants are running. | |
112 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
113 ;; It is possible to detect XEmacs/mule by (featurep 'mule) and |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
114 ;; checking `emacs-version'. In this case, the implementation for |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
115 ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. |
17493 | 116 |
117 (defvar gnus-summary-display-table nil | |
118 "Display table used in summary mode buffers.") | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
119 (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) |
17493 | 120 |
121 (when (boundp 'gnus-check-before-posting) | |
122 (setq gnus-check-before-posting | |
123 (delq 'long-lines | |
124 (delq 'control-chars gnus-check-before-posting)))) | |
125 | |
126 (defun gnus-summary-line-format-spec () | |
127 (insert gnus-tmp-unread gnus-tmp-replied | |
128 gnus-tmp-score-char gnus-tmp-indentation) | |
129 (put-text-property | |
130 (point) | |
131 (progn | |
132 (insert | |
133 gnus-tmp-opening-bracket | |
134 (format "%4d: %-20s" | |
135 gnus-tmp-lines | |
136 (if (> (length gnus-tmp-name) 20) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
137 (truncate-string-to-width gnus-tmp-name 20) |
17493 | 138 gnus-tmp-name)) |
139 gnus-tmp-closing-bracket) | |
140 (point)) | |
141 gnus-mouse-face-prop gnus-mouse-face) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
142 (insert " " gnus-tmp-subject-or-nil "\n"))))) |
17493 | 143 |
144 (defun gnus-region-active-p () | |
145 "Say whether the region is active." | |
146 (and (boundp 'transient-mark-mode) | |
147 transient-mark-mode | |
148 (boundp 'mark-active) | |
149 mark-active)) | |
150 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
151 (if (fboundp 'add-minor-mode) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
152 (defalias 'gnus-add-minor-mode 'add-minor-mode) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
153 (defun gnus-add-minor-mode (mode name map &rest rest) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
154 (set (make-local-variable mode) t) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
155 (unless (assq mode minor-mode-alist) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
156 (push `(,mode ,name) minor-mode-alist)) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
157 (unless (assq mode minor-mode-map-alist) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
158 (push (cons mode map) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
159 minor-mode-map-alist)))) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
160 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
161 (defun gnus-x-splash () |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
162 "Show a splash screen using a pixmap in the current buffer." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
163 (let ((dir (nnheader-find-etc-directory "gnus")) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
164 pixmap file height beg i) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
165 (save-excursion |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
166 (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer)) |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
167 (let ((buffer-read-only nil) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
168 width height) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
169 (erase-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
170 (when (and dir |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
171 (file-exists-p (setq file |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
172 (expand-file-name "x-splash" dir)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
173 (with-temp-buffer |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
174 (insert-file-contents file) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
175 (goto-char (point-min)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
176 (ignore-errors |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
177 (setq pixmap (read (current-buffer)))))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
178 (when pixmap |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
179 (make-face 'gnus-splash) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
180 (setq height (/ (car pixmap) (frame-char-height)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
181 width (/ (cadr pixmap) (frame-char-width))) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
182 (set-face-foreground 'gnus-splash "Brown") |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
183 (set-face-stipple 'gnus-splash pixmap) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
184 (insert-char ?\n (* (/ (window-height) 2 height) height)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
185 (setq i height) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
186 (while (> i 0) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
187 (insert-char ?\ (* (/ (window-width) 2 width) width)) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
188 (setq beg (point)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
189 (insert-char ?\ width) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
190 (set-text-properties beg (point) '(face gnus-splash)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
191 (insert ?\n) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
192 (decf i)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
193 (goto-char (point-min)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
194 (sit-for 0)))))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
195 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
196 (defvar gnus-article-xface-ring-internal nil |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
197 "Cache for face data.") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
198 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
199 ;; Worth customizing? |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
200 (defvar gnus-article-xface-ring-size 6 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
201 "Length of the ring used for `gnus-article-xface-ring-internal'.") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
202 |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
203 (defvar gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
204 (eq 0 (string-match "#define" (shell-command-to-string "uncompface -X"))) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
205 "Non-nil means the compface program supports the -X option. |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
206 That produces XBM output.") |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
207 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
208 (defun gnus-article-display-xface (beg end) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
209 "Display an XFace header from between BEG and END in the current article. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
210 Requires support for images in your Emacs and the external programs |
31767
bdb5ce245f0e
(gnus-article-display-xface): Don't convert PBM
Gerd Moellmann <gerd@gnu.org>
parents:
31716
diff
changeset
|
211 `uncompface', and `icontopbm'. On a GNU/Linux system these |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
212 might be in packages with names like `compface' or `faces-xface' and |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
213 `netpbm' or `libgr-progs', for instance. See also |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
214 `gnus-article-compface-xbm'. |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
215 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
216 This function is for Emacs 21+. See `gnus-xmas-article-display-xface' |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
217 for XEmacs." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
218 ;; It might be worth converting uncompface's output in Lisp. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
219 |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
220 (when (if (fboundp 'display-graphic-p) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
221 (display-graphic-p)) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
222 (unless gnus-article-xface-ring-internal ; Only load ring when needed. |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
223 (setq gnus-article-xface-ring-internal |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
224 (make-ring gnus-article-xface-ring-size))) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
225 (save-excursion |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
226 (let* ((cur (current-buffer)) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
227 (data (buffer-substring beg end)) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
228 (image (cdr-safe (assoc data (ring-elements |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
229 gnus-article-xface-ring-internal)))) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
230 default-enable-multibyte-characters) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
231 (unless image |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
232 (with-temp-buffer |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
233 (insert data) |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
234 (and (eq 0 (apply #'call-process-region (point-min) (point-max) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
235 "uncompface" |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
236 'delete '(t nil) nil |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
237 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
238 '("-X")))) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
239 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
240 t |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
241 (goto-char (point-min)) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
242 (progn (insert "/* Width=48, Height=48 */\n") t) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
243 (eq 0 (call-process-region (point-min) (point-max) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
244 "icontopbm" |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
245 'delete '(t nil)))) |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
246 ;; Miles Bader says that faces don't look right as |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
247 ;; light on dark. |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
248 (if (eq 'dark (cdr-safe (assq 'background-mode |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
249 (frame-parameters)))) |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
250 (setq image (create-image (buffer-string) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
251 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
252 'xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
253 'pbm) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
254 t |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
255 :ascent 'center |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
256 :foreground "black" |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
257 :background "white")) |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
258 (setq image (create-image (buffer-string) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
259 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
260 'xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
261 'pbm) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
262 t |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
263 :ascent 'center))))) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
264 (ring-insert gnus-article-xface-ring-internal (cons data image))) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
265 (when image |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
266 (goto-char (point-min)) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
267 (re-search-forward "^From:" nil 'move) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
268 (insert-image image)))))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
269 |
17493 | 270 (provide 'gnus-ems) |
271 | |
272 ;;; gnus-ems.el ends here |