Mercurial > emacs
annotate lisp/gnus/gnus-ems.el @ 41383:0a19aeab6a44
*** empty log message ***
author | Colin Walters <walters@gnu.org> |
---|---|
date | Fri, 23 Nov 2001 01:28:37 +0000 |
parents | dc7a5767765d |
children | b94ae378e07c |
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 (eval-and-compile | |
80 (let ((case-fold-search t)) | |
81 (cond | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
82 ((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
|
83 (symbol-name system-type)) |
17493 | 84 (setq nnheader-file-name-translation-alist |
85 (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
|
86 (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
|
87 '(?: ?* ?\" ?< ?> ??)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
88 '((?+ . ?-)))))))) |
17493 | 89 |
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) | |
99 | |
100 (defun gnus-ems-redefine () | |
101 (cond | |
32939
c8119677d63e
Use (featurep 'xemacs) instead of the `gnus-xemacs' variable, as the
Miles Bader <miles@gnu.org>
parents:
32920
diff
changeset
|
102 ((featurep 'xemacs) |
17493 | 103 (gnus-xmas-redefine)) |
104 | |
105 ((featurep 'mule) | |
106 ;; Mule and new Emacs definitions | |
107 | |
108 ;; [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
|
109 ;; 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
|
110 ;; MULE features. Unfortunately these API are different. In |
17493 | 111 ;; 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
|
112 ;; 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
|
113 ;; 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
|
114 |
17493 | 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. | |
119 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
120 ;; 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
|
121 ;; 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
|
122 ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. |
17493 | 123 |
124 (defvar gnus-summary-display-table nil | |
125 "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
|
126 (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) |
17493 | 127 |
128 (when (boundp 'gnus-check-before-posting) | |
129 (setq gnus-check-before-posting | |
130 (delq 'long-lines | |
131 (delq 'control-chars gnus-check-before-posting)))) | |
132 | |
133 (defun gnus-summary-line-format-spec () | |
134 (insert gnus-tmp-unread gnus-tmp-replied | |
135 gnus-tmp-score-char gnus-tmp-indentation) | |
136 (put-text-property | |
137 (point) | |
138 (progn | |
139 (insert | |
140 gnus-tmp-opening-bracket | |
141 (format "%4d: %-20s" | |
142 gnus-tmp-lines | |
143 (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
|
144 (truncate-string-to-width gnus-tmp-name 20) |
17493 | 145 gnus-tmp-name)) |
146 gnus-tmp-closing-bracket) | |
147 (point)) | |
148 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
|
149 (insert " " gnus-tmp-subject-or-nil "\n"))))) |
17493 | 150 |
151 (defun gnus-region-active-p () | |
152 "Say whether the region is active." | |
153 (and (boundp 'transient-mark-mode) | |
154 transient-mark-mode | |
155 (boundp 'mark-active) | |
156 mark-active)) | |
157 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
158 (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
|
159 (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
|
160 (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
|
161 (set (make-local-variable mode) t) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
162 (unless (assq mode minor-mode-alist) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
163 (push `(,mode ,name) minor-mode-alist)) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
164 (unless (assq mode minor-mode-map-alist) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
165 (push (cons mode map) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
166 minor-mode-map-alist)))) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
167 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
168 (defun gnus-x-splash () |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
169 "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
|
170 (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
|
171 pixmap file height beg i) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
172 (save-excursion |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
173 (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
|
174 (let ((buffer-read-only nil) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
175 width height) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
176 (erase-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
177 (when (and dir |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
178 (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
|
179 (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
|
180 (with-temp-buffer |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
181 (insert-file-contents file) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
182 (goto-char (point-min)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
183 (ignore-errors |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
184 (setq pixmap (read (current-buffer)))))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
185 (when pixmap |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
186 (make-face 'gnus-splash) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
187 (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
|
188 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
|
189 (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
|
190 (set-face-stipple 'gnus-splash pixmap) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
191 (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
|
192 (setq i height) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
193 (while (> i 0) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
194 (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
|
195 (setq beg (point)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
196 (insert-char ?\ width) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
197 (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
|
198 (insert ?\n) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
199 (decf i)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
200 (goto-char (point-min)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
201 (sit-for 0)))))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
202 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
203 (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
|
204 "Cache for face data.") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
205 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
206 ;; Worth customizing? |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
207 (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
|
208 "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
|
209 |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
210 (defvar gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
211 (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
|
212 "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
|
213 That produces XBM output.") |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
214 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
215 (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
|
216 "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
|
217 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
|
218 `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
|
219 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
|
220 `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
|
221 `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
|
222 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
223 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
|
224 for XEmacs." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
225 ;; 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
|
226 |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
227 (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
|
228 (display-graphic-p)) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
229 (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
|
230 (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
|
231 (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
|
232 (save-excursion |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
233 (let* ((cur (current-buffer)) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
234 (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
|
235 (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
|
236 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
|
237 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
|
238 (unless image |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
239 (with-temp-buffer |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
240 (insert data) |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
241 (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
|
242 "uncompface" |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
243 'delete '(t nil) nil |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
244 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
245 '("-X")))) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
246 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
247 t |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
248 (goto-char (point-min)) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
249 (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
|
250 (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
|
251 "icontopbm" |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
252 'delete '(t nil)))) |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
253 ;; 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
|
254 ;; light on dark. |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
255 (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
|
256 (frame-parameters)))) |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
257 (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
|
258 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
259 'xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
260 'pbm) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
261 t |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
262 :ascent 'center |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
263 :foreground "black" |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
264 :background "white")) |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
265 (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
|
266 (if gnus-article-compface-xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
267 'xbm |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
268 'pbm) |
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
269 t |
31802
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
270 :ascent 'center))))) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
271 (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
|
272 (when image |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
273 (goto-char (point-min)) |
c182c9b42c86
(gnus-article-display-xface): Use unibyte for the image processing.
Dave Love <fx@gnu.org>
parents:
31780
diff
changeset
|
274 (re-search-forward "^From:" nil 'move) |
39483
dc7a5767765d
(gnus-article-display-xface): Skip over previously
Gerd Moellmann <gerd@gnu.org>
parents:
33814
diff
changeset
|
275 (while (get-text-property (point) 'display) |
dc7a5767765d
(gnus-article-display-xface): Skip over previously
Gerd Moellmann <gerd@gnu.org>
parents:
33814
diff
changeset
|
276 (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
|
277 (insert-image image)))))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
278 |
17493 | 279 (provide 'gnus-ems) |
280 | |
281 ;;; gnus-ems.el ends here |