Mercurial > emacs
annotate lisp/gnus/gnus-ems.el @ 89573:6b5d42f51038
(x_get_font_repertory): Handle the case that the
encoding of font is other than Unicode.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Mon, 06 Oct 2003 11:23:25 +0000 |
parents | 375f2633d815 |
children | 561b856c5b1f |
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 | |
33814 | 29 (eval-when-compile |
30 (require 'cl) | |
31 (require 'ring)) | |
17493 | 32 |
33 ;;; Function aliases later to be redefined for XEmacs usage. | |
34 | |
35 (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
|
36 (defvar gnus-down-mouse-3 [down-mouse-3]) |
17493 | 37 (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
|
38 (defvar gnus-widget-button-keymap nil) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
39 (defvar gnus-mode-line-modified |
32920
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
40 (if (or (featurep 'xemacs) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
41 (< emacs-major-version 20)) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
42 '("--**-" . "-----") |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
43 '("**" "--"))) |
17493 | 44 |
45 (eval-and-compile | |
46 (autoload 'gnus-xmas-define "gnus-xmas") | |
47 (autoload 'gnus-xmas-redefine "gnus-xmas") | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
48 (autoload 'appt-select-lowest-window "appt")) |
17493 | 49 |
32920
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
50 (if (featurep 'xemacs) |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
51 (autoload 'gnus-smiley-display "smiley") |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
52 (autoload 'gnus-smiley-display "smiley-ems") ; override XEmacs version |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
53 ) |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
54 |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
55 (defun gnus-kill-all-overlays () |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
56 "Delete all overlays in the current buffer." |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
57 (let* ((overlayss (overlay-lists)) |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
58 (buffer-read-only nil) |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
59 (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
60 (while overlays |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
61 (delete-overlay (pop overlays))))) |
31780
d2b5643aab16
(gnus-smiley-display): Autoload from smiley-ems.
Dave Love <fx@gnu.org>
parents:
31767
diff
changeset
|
62 |
17493 | 63 ;;; Mule functions. |
64 | |
65 (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
|
66 `(let* ((val (eval (, el))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
67 (valstr (if (numberp val) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
68 (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
|
69 (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
|
70 (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
|
71 valstr))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
72 |
17493 | 73 (eval-and-compile |
32920
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
74 (if (featurep 'xemacs) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
75 (gnus-xmas-define) |
17493 | 76 (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
|
77 "Property used for highlighting mouse regions."))) |
17493 | 78 |
79 (defvar gnus-tmp-unread) | |
80 (defvar gnus-tmp-replied) | |
81 (defvar gnus-tmp-score-char) | |
82 (defvar gnus-tmp-indentation) | |
83 (defvar gnus-tmp-opening-bracket) | |
84 (defvar gnus-tmp-lines) | |
85 (defvar gnus-tmp-name) | |
86 (defvar gnus-tmp-closing-bracket) | |
87 (defvar gnus-tmp-subject-or-nil) | |
88 | |
89 (defun gnus-ems-redefine () | |
90 (cond | |
32939
c8119677d63e
Use (featurep 'xemacs) instead of the `gnus-xemacs' variable, as the
Miles Bader <miles@gnu.org>
parents:
32920
diff
changeset
|
91 ((featurep 'xemacs) |
17493 | 92 (gnus-xmas-redefine)) |
93 | |
94 ((featurep 'mule) | |
95 ;; Mule and new Emacs definitions | |
96 | |
97 ;; [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
|
98 ;; 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
|
99 ;; MULE features. Unfortunately these API are different. In |
17493 | 100 ;; particular, Emacs (including original MULE) and XEmacs are |
44532
b94ae378e07c
(gnus-ems-redefine): Fix typo in comment.
Juanma Barranquero <lekktu@gmail.com>
parents:
39483
diff
changeset
|
101 ;; quite different. However, this version of Gnus doesn't support |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
102 ;; 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
|
103 |
17493 | 104 ;; Predicates to check are following: |
105 ;; (boundp 'MULE) is t only if MULE (original; anything older than | |
106 ;; Mule 2.3) is running. | |
107 ;; (featurep 'mule) is t when every mule variants are running. | |
108 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
109 ;; 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
|
110 ;; 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
|
111 ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. |
17493 | 112 |
113 (defvar gnus-summary-display-table nil | |
114 "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
|
115 (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) |
17493 | 116 |
117 (when (boundp 'gnus-check-before-posting) | |
118 (setq gnus-check-before-posting | |
119 (delq 'long-lines | |
120 (delq 'control-chars gnus-check-before-posting)))) | |
121 | |
122 (defun gnus-summary-line-format-spec () | |
123 (insert gnus-tmp-unread gnus-tmp-replied | |
124 gnus-tmp-score-char gnus-tmp-indentation) | |
125 (put-text-property | |
126 (point) | |
127 (progn | |
128 (insert | |
129 gnus-tmp-opening-bracket | |
130 (format "%4d: %-20s" | |
131 gnus-tmp-lines | |
132 (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
|
133 (truncate-string-to-width gnus-tmp-name 20) |
17493 | 134 gnus-tmp-name)) |
135 gnus-tmp-closing-bracket) | |
136 (point)) | |
137 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
|
138 (insert " " gnus-tmp-subject-or-nil "\n"))))) |
17493 | 139 |
140 (defun gnus-region-active-p () | |
141 "Say whether the region is active." | |
142 (and (boundp 'transient-mark-mode) | |
143 transient-mark-mode | |
144 (boundp 'mark-active) | |
145 mark-active)) | |
146 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
147 (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
|
148 (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
|
149 (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
|
150 (set (make-local-variable mode) t) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
151 (unless (assq mode minor-mode-alist) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
152 (push `(,mode ,name) minor-mode-alist)) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
153 (unless (assq mode minor-mode-map-alist) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
154 (push (cons mode map) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
155 minor-mode-map-alist)))) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
156 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
157 (defun gnus-x-splash () |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
158 "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
|
159 (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
|
160 pixmap file height beg i) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
161 (save-excursion |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
162 (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
|
163 (let ((buffer-read-only nil) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
164 width height) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
165 (erase-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
166 (when (and dir |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
167 (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
|
168 (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
|
169 (with-temp-buffer |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
170 (insert-file-contents file) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
171 (goto-char (point-min)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
172 (ignore-errors |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
173 (setq pixmap (read (current-buffer)))))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
174 (when pixmap |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
175 (make-face 'gnus-splash) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
176 (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
|
177 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
|
178 (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
|
179 (set-face-stipple 'gnus-splash pixmap) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
180 (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
|
181 (setq i height) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
182 (while (> i 0) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
183 (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
|
184 (setq beg (point)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
185 (insert-char ?\ width) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
186 (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
|
187 (insert ?\n) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
188 (decf i)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
189 (goto-char (point-min)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
190 (sit-for 0)))))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
191 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
192 (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
|
193 "Cache for face data.") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
194 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
195 ;; Worth customizing? |
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-size 6 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
197 "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
|
198 |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
199 (defvar gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
200 (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
|
201 "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
|
202 That produces XBM output.") |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
203 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
204 (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
|
205 "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
|
206 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
|
207 `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
|
208 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
|
209 `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
|
210 `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
|
211 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
212 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
|
213 for XEmacs." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
214 ;; 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
|
215 |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
216 (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
|
217 (display-graphic-p)) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
218 (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
|
219 (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
|
220 (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
|
221 (save-excursion |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
222 (let* ((cur (current-buffer)) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
223 (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
|
224 (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
|
225 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
|
226 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
|
227 (unless image |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
228 (with-temp-buffer |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
229 (insert data) |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
230 (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
|
231 "uncompface" |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
232 'delete '(t nil) nil |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
233 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
234 '("-X")))) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
235 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
236 t |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
237 (goto-char (point-min)) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
238 (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
|
239 (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
|
240 "icontopbm" |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
241 'delete '(t nil)))) |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
242 ;; 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
|
243 ;; light on dark. |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
244 (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
|
245 (frame-parameters)))) |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
246 (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
|
247 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
248 'xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
249 'pbm) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
250 t |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
251 :ascent 'center |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
252 :foreground "black" |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
253 :background "white")) |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
254 (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
|
255 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
256 'xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
257 'pbm) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
258 t |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
259 :ascent 'center))))) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
260 (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
|
261 (when image |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
262 (goto-char (point-min)) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
263 (re-search-forward "^From:" nil 'move) |
39483
dc7a5767765d
(gnus-article-display-xface): Skip over previously
Gerd Moellmann <gerd@gnu.org>
parents:
33814
diff
changeset
|
264 (while (get-text-property (point) 'display) |
dc7a5767765d
(gnus-article-display-xface): Skip over previously
Gerd Moellmann <gerd@gnu.org>
parents:
33814
diff
changeset
|
265 (goto-char (next-single-property-change (point) 'display))) |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
266 (insert-image image)))))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
267 |
17493 | 268 (provide 'gnus-ems) |
269 | |
270 ;;; gnus-ems.el ends here |