Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-ems.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Keywords: news
6
7 ;; This file is part of GNU Emacs.
8
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 (eval-when-compile (require 'cl))
29
30 (defvar gnus-mouse-2 [mouse-2])
31
32 (defalias 'gnus-make-overlay 'make-overlay)
33 (defalias 'gnus-overlay-put 'overlay-put)
34 (defalias 'gnus-move-overlay 'move-overlay)
35 (defalias 'gnus-overlay-end 'overlay-end)
36 (defalias 'gnus-extent-detached-p 'ignore)
37 (defalias 'gnus-extent-start-open 'ignore)
38 (defalias 'gnus-set-text-properties 'set-text-properties)
39 (defalias 'gnus-group-remove-excess-properties 'ignore)
40 (defalias 'gnus-topic-remove-excess-properties 'ignore)
41 (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
42 (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
43 (defalias 'gnus-make-local-hook 'make-local-hook)
44 (defalias 'gnus-add-hook 'add-hook)
45 (defalias 'gnus-character-to-event 'identity)
46 (defalias 'gnus-add-text-properties 'add-text-properties)
47 (defalias 'gnus-put-text-property 'put-text-property)
48 (defalias 'gnus-mode-line-buffer-identification 'identity)
49
50
51 (eval-and-compile
52 (autoload 'gnus-xmas-define "gnus-xmas")
53 (autoload 'gnus-xmas-redefine "gnus-xmas")
54 (autoload 'appt-select-lowest-window "appt.el"))
55
56 (or (fboundp 'mail-file-babyl-p)
57 (fset 'mail-file-babyl-p 'rmail-file-p))
58
59 ;;; Mule functions.
60
61 (defun gnus-mule-cite-add-face (number prefix face)
62 ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
63 (if face
64 (let ((inhibit-point-motion-hooks t)
65 from to)
66 (goto-line number)
67 (if (boundp 'MULE)
68 (forward-char (chars-in-string prefix))
69 (forward-char (length prefix)))
70 (skip-chars-forward " \t")
71 (setq from (point))
72 (end-of-line 1)
73 (skip-chars-backward " \t")
74 (setq to (point))
75 (if (< from to)
76 (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))
77
78 (defun gnus-mule-max-width-function (el max-width)
79 (` (let* ((val (eval (, el)))
80 (valstr (if (numberp val)
81 (int-to-string val) val)))
82 (if (> (length valstr) (, max-width))
83 (truncate-string valstr (, max-width))
84 valstr))))
85
86 (eval-and-compile
87 (if (string-match "XEmacs\\|Lucid" emacs-version)
88 ()
89
90 (defvar gnus-mouse-face-prop 'mouse-face
91 "Property used for highlighting mouse regions.")
92
93 (defvar gnus-article-x-face-command
94 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
95 "String or function to be executed to display an X-Face header.
96 If it is a string, the command will be executed in a sub-shell
97 asynchronously. The compressed face will be piped to this command.")
98
99 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
100 (defvar gnus-display-type
101 (condition-case nil
102 (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
103 (cond (display-resource (intern (downcase display-resource)))
104 ((x-display-color-p) 'color)
105 ((x-display-grayscale-p) 'grayscale)
106 (t 'mono)))
107 (error 'mono))
108 "A symbol indicating the display Emacs is running under.
109 The symbol should be one of `color', `grayscale' or `mono'. If Emacs
110 guesses this display attribute wrongly, either set this variable in
111 your `~/.emacs' or set the resource `Emacs.displayType' in your
112 `~/.Xdefaults'. See also `gnus-background-mode'.
113
114 This is a meta-variable that will affect what default values other
115 variables get. You would normally not change this variable, but
116 pounce directly on the real variables themselves.")
117
118 (defvar gnus-background-mode
119 (condition-case nil
120 (let ((bg-resource (x-get-resource ".backgroundMode"
121 "BackgroundMode"))
122 (params (frame-parameters)))
123 (cond (bg-resource (intern (downcase bg-resource)))
124 ((and (cdr (assq 'background-color params))
125 (< (apply '+ (x-color-values
126 (cdr (assq 'background-color params))))
127 (/ (apply '+ (x-color-values "white")) 3)))
128 'dark)
129 (t 'light)))
130 (error 'light))
131 "A symbol indicating the Emacs background brightness.
132 The symbol should be one of `light' or `dark'.
133 If Emacs guesses this frame attribute wrongly, either set this variable in
134 your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
135 `~/.Xdefaults'.
136 See also `gnus-display-type'.
137
138 This is a meta-variable that will affect what default values other
139 variables get. You would normally not change this variable, but
140 pounce directly on the real variables themselves."))
141
142 (cond
143 ((string-match "XEmacs\\|Lucid" emacs-version)
144 (gnus-xmas-define))
145
146 ((or (not (boundp 'emacs-minor-version))
147 (< emacs-minor-version 30))
148 ;; Remove the `intangible' prop.
149 (let ((props (and (boundp 'gnus-hidden-properties)
150 gnus-hidden-properties)))
151 (while (and props (not (eq (car (cdr props)) 'intangible)))
152 (setq props (cdr props)))
153 (and props (setcdr props (cdr (cdr (cdr props))))))
154 (or (fboundp 'buffer-substring-no-properties)
155 (defun buffer-substring-no-properties (beg end)
156 (format "%s" (buffer-substring beg end)))))
157
158 ((boundp 'MULE)
159 (provide 'gnusutil))))
160
161 (eval-and-compile
162 (cond
163 ((not window-system)
164 (defun gnus-dummy-func (&rest args))
165 (let ((funcs '(mouse-set-point set-face-foreground
166 set-face-background x-popup-menu)))
167 (while funcs
168 (or (fboundp (car funcs))
169 (fset (car funcs) 'gnus-dummy-func))
170 (setq funcs (cdr funcs))))))
171 (or (fboundp 'file-regular-p)
172 (defun file-regular-p (file)
173 (and (not (file-directory-p file))
174 (not (file-symlink-p file))
175 (file-exists-p file))))
176 (or (fboundp 'face-list)
177 (defun face-list (&rest args))))
178
179 (eval-and-compile
180 (let ((case-fold-search t))
181 (cond
182 ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type))
183 (setq nnheader-file-name-translation-alist
184 (append nnheader-file-name-translation-alist
185 '((?: . ?_)
186 (?+ . ?-))))))))
187
188 (defvar gnus-tmp-unread)
189 (defvar gnus-tmp-replied)
190 (defvar gnus-tmp-score-char)
191 (defvar gnus-tmp-indentation)
192 (defvar gnus-tmp-opening-bracket)
193 (defvar gnus-tmp-lines)
194 (defvar gnus-tmp-name)
195 (defvar gnus-tmp-closing-bracket)
196 (defvar gnus-tmp-subject-or-nil)
197
198 (defun gnus-ems-redefine ()
199 (cond
200 ((string-match "XEmacs\\|Lucid" emacs-version)
201 (gnus-xmas-redefine))
202
203 ((boundp 'MULE)
204 ;; Mule definitions
205 (defalias 'gnus-truncate-string 'truncate-string)
206
207 (fset 'gnus-summary-make-display-table (lambda () nil))
208 (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)
209 (fset 'gnus-max-width-function 'gnus-mule-max-width-function)
210
211 (if (boundp 'gnus-check-before-posting)
212 (setq gnus-check-before-posting
213 (delq 'long-lines
214 (delq 'control-chars gnus-check-before-posting))))
215
216 (defun gnus-summary-line-format-spec ()
217 (insert gnus-tmp-unread gnus-tmp-replied
218 gnus-tmp-score-char gnus-tmp-indentation)
219 (put-text-property
220 (point)
221 (progn
222 (insert
223 gnus-tmp-opening-bracket
224 (format "%4d: %-20s"
225 gnus-tmp-lines
226 (if (> (length gnus-tmp-name) 20)
227 (truncate-string gnus-tmp-name 20)
228 gnus-tmp-name))
229 gnus-tmp-closing-bracket)
230 (point))
231 gnus-mouse-face-prop gnus-mouse-face)
232 (insert " " gnus-tmp-subject-or-nil "\n"))
233 )))
234
235
236 (provide 'gnus-ems)
237
238 ;; Local Variables:
239 ;; byte-compile-warnings: '(redefine callargs)
240 ;; End:
241
242 ;;; gnus-ems.el ends here