Commit | Line | Data |
---|---|---|
185a608e | 1 | ;;; gnus-spec.el --- format spec functions for Gnus -*- coding: iso-latin-1 -*- |
16409b0b GM |
2 | ;; Copyright (C) 1996, 1997, 1998, 1999, 2000 |
3 | ;; Free Software Foundation, Inc. | |
eec82323 | 4 | |
6748645f | 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
eec82323 LMI |
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 | ||
5ab7173c RS |
29 | (eval-when-compile (require 'cl)) |
30 | ||
eec82323 LMI |
31 | (require 'gnus) |
32 | ||
33 | ;;; Internal variables. | |
34 | ||
35 | (defvar gnus-summary-mark-positions nil) | |
36 | (defvar gnus-group-mark-positions nil) | |
37 | (defvar gnus-group-indentation "") | |
38 | ||
39 | ;; Format specs. The chunks below are the machine-generated forms | |
40 | ;; that are to be evaled as the result of the default format strings. | |
41 | ;; We write them in here to get them byte-compiled. That way the | |
42 | ;; default actions will be quite fast, while still retaining the full | |
43 | ;; flexibility of the user-defined format specs. | |
44 | ||
45 | ;; First we have lots of dummy defvars to let the compiler know these | |
46 | ;; are really dynamic variables. | |
47 | ||
48 | (defvar gnus-tmp-unread) | |
49 | (defvar gnus-tmp-replied) | |
50 | (defvar gnus-tmp-score-char) | |
51 | (defvar gnus-tmp-indentation) | |
52 | (defvar gnus-tmp-opening-bracket) | |
53 | (defvar gnus-tmp-lines) | |
54 | (defvar gnus-tmp-name) | |
55 | (defvar gnus-tmp-closing-bracket) | |
56 | (defvar gnus-tmp-subject-or-nil) | |
57 | (defvar gnus-tmp-subject) | |
58 | (defvar gnus-tmp-marked) | |
59 | (defvar gnus-tmp-marked-mark) | |
60 | (defvar gnus-tmp-subscribed) | |
61 | (defvar gnus-tmp-process-marked) | |
62 | (defvar gnus-tmp-number-of-unread) | |
63 | (defvar gnus-tmp-group-name) | |
64 | (defvar gnus-tmp-group) | |
65 | (defvar gnus-tmp-article-number) | |
66 | (defvar gnus-tmp-unread-and-unselected) | |
67 | (defvar gnus-tmp-news-method) | |
68 | (defvar gnus-tmp-news-server) | |
69 | (defvar gnus-tmp-article-number) | |
70 | (defvar gnus-mouse-face) | |
71 | (defvar gnus-mouse-face-prop) | |
72 | ||
73 | (defun gnus-summary-line-format-spec () | |
74 | (insert gnus-tmp-unread gnus-tmp-replied | |
75 | gnus-tmp-score-char gnus-tmp-indentation) | |
76 | (gnus-put-text-property | |
77 | (point) | |
78 | (progn | |
79 | (insert | |
80 | gnus-tmp-opening-bracket | |
81 | (format "%4d: %-20s" | |
82 | gnus-tmp-lines | |
83 | (if (> (length gnus-tmp-name) 20) | |
84 | (substring gnus-tmp-name 0 20) | |
85 | gnus-tmp-name)) | |
86 | gnus-tmp-closing-bracket) | |
87 | (point)) | |
88 | gnus-mouse-face-prop gnus-mouse-face) | |
89 | (insert " " gnus-tmp-subject-or-nil "\n")) | |
90 | ||
91 | (defvar gnus-summary-line-format-spec | |
92 | (gnus-byte-code 'gnus-summary-line-format-spec)) | |
93 | ||
94 | (defun gnus-summary-dummy-line-format-spec () | |
95 | (insert "* ") | |
96 | (gnus-put-text-property | |
97 | (point) | |
98 | (progn | |
99 | (insert ": :") | |
100 | (point)) | |
101 | gnus-mouse-face-prop gnus-mouse-face) | |
102 | (insert " " gnus-tmp-subject "\n")) | |
103 | ||
104 | (defvar gnus-summary-dummy-line-format-spec | |
105 | (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) | |
106 | ||
107 | (defun gnus-group-line-format-spec () | |
108 | (insert gnus-tmp-marked-mark gnus-tmp-subscribed | |
109 | gnus-tmp-process-marked | |
110 | gnus-group-indentation | |
111 | (format "%5s: " gnus-tmp-number-of-unread)) | |
112 | (gnus-put-text-property | |
113 | (point) | |
114 | (progn | |
115 | (insert gnus-tmp-group "\n") | |
116 | (1- (point))) | |
117 | gnus-mouse-face-prop gnus-mouse-face)) | |
118 | (defvar gnus-group-line-format-spec | |
119 | (gnus-byte-code 'gnus-group-line-format-spec)) | |
120 | ||
121 | (defvar gnus-format-specs | |
122 | `((version . ,emacs-version) | |
123 | (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) | |
124 | (summary-dummy "* %(: :%) %S\n" | |
125 | ,gnus-summary-dummy-line-format-spec) | |
126 | (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" | |
127 | ,gnus-summary-line-format-spec)) | |
128 | "Alist of format specs.") | |
129 | ||
130 | (defvar gnus-article-mode-line-format-spec nil) | |
131 | (defvar gnus-summary-mode-line-format-spec nil) | |
132 | (defvar gnus-group-mode-line-format-spec nil) | |
133 | ||
134 | ;;; Phew. All that gruft is over, fortunately. | |
135 | ||
136 | ;;;###autoload | |
137 | (defun gnus-update-format (var) | |
138 | "Update the format specification near point." | |
139 | (interactive | |
140 | (list | |
141 | (save-excursion | |
142 | (eval-defun nil) | |
143 | ;; Find the end of the current word. | |
144 | (re-search-forward "[ \t\n]" nil t) | |
145 | ;; Search backward. | |
146 | (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t) | |
147 | (match-string 1))))) | |
148 | (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) | |
149 | (match-string 1 var)))) | |
150 | (entry (assq type gnus-format-specs)) | |
151 | value spec) | |
152 | (when entry | |
153 | (setq gnus-format-specs (delq entry gnus-format-specs))) | |
154 | (set | |
155 | (intern (format "%s-spec" var)) | |
156 | (gnus-parse-format (setq value (symbol-value (intern var))) | |
157 | (symbol-value (intern (format "%s-alist" var))) | |
158 | (not (string-match "mode" var)))) | |
159 | (setq spec (symbol-value (intern (format "%s-spec" var)))) | |
160 | (push (list type value spec) gnus-format-specs) | |
161 | ||
162 | (pop-to-buffer "*Gnus Format*") | |
163 | (erase-buffer) | |
164 | (lisp-interaction-mode) | |
165 | (insert (pp-to-string spec)))) | |
166 | ||
167 | (defun gnus-update-format-specifications (&optional force &rest types) | |
168 | "Update all (necessary) format specifications." | |
169 | ;; Make the indentation array. | |
170 | ;; See whether all the stored info needs to be flushed. | |
171 | (when (or force | |
172 | (not (equal emacs-version | |
173 | (cdr (assq 'version gnus-format-specs))))) | |
174 | (setq gnus-format-specs nil)) | |
175 | ||
176 | ;; Go through all the formats and see whether they need updating. | |
177 | (let (new-format entry type val) | |
178 | (while (setq type (pop types)) | |
179 | ;; Jump to the proper buffer to find out the value of | |
180 | ;; the variable, if possible. (It may be buffer-local.) | |
181 | (save-excursion | |
182 | (let ((buffer (intern (format "gnus-%s-buffer" type))) | |
183 | val) | |
184 | (when (and (boundp buffer) | |
185 | (setq val (symbol-value buffer)) | |
6748645f LMI |
186 | (gnus-buffer-exists-p val)) |
187 | (set-buffer val)) | |
eec82323 LMI |
188 | (setq new-format (symbol-value |
189 | (intern (format "gnus-%s-line-format" type))))) | |
190 | (setq entry (cdr (assq type gnus-format-specs))) | |
191 | (if (and (car entry) | |
192 | (equal (car entry) new-format)) | |
193 | ;; Use the old format. | |
194 | (set (intern (format "gnus-%s-line-format-spec" type)) | |
195 | (cadr entry)) | |
196 | ;; This is a new format. | |
197 | (setq val | |
198 | (if (not (stringp new-format)) | |
199 | ;; This is a function call or something. | |
200 | new-format | |
201 | ;; This is a "real" format. | |
202 | (gnus-parse-format | |
203 | new-format | |
204 | (symbol-value | |
16409b0b | 205 | (intern (format "gnus-%s-line-format-alist" type))) |
eec82323 LMI |
206 | (not (string-match "mode$" (symbol-name type)))))) |
207 | ;; Enter the new format spec into the list. | |
208 | (if entry | |
209 | (progn | |
210 | (setcar (cdr entry) val) | |
211 | (setcar entry new-format)) | |
212 | (push (list type new-format val) gnus-format-specs)) | |
213 | (set (intern (format "gnus-%s-line-format-spec" type)) val))))) | |
214 | ||
215 | (unless (assq 'version gnus-format-specs) | |
216 | (push (cons 'version emacs-version) gnus-format-specs))) | |
217 | ||
218 | (defvar gnus-mouse-face-0 'highlight) | |
219 | (defvar gnus-mouse-face-1 'highlight) | |
220 | (defvar gnus-mouse-face-2 'highlight) | |
221 | (defvar gnus-mouse-face-3 'highlight) | |
222 | (defvar gnus-mouse-face-4 'highlight) | |
223 | ||
224 | (defun gnus-mouse-face-function (form type) | |
225 | `(gnus-put-text-property | |
226 | (point) (progn ,@form (point)) | |
227 | gnus-mouse-face-prop | |
228 | ,(if (equal type 0) | |
229 | 'gnus-mouse-face | |
230 | `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) | |
231 | ||
232 | (defvar gnus-face-0 'bold) | |
233 | (defvar gnus-face-1 'italic) | |
234 | (defvar gnus-face-2 'bold-italic) | |
235 | (defvar gnus-face-3 'bold) | |
236 | (defvar gnus-face-4 'bold) | |
237 | ||
238 | (defun gnus-face-face-function (form type) | |
6748645f | 239 | `(gnus-add-text-properties |
eec82323 | 240 | (point) (progn ,@form (point)) |
6748645f | 241 | '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type)))))) |
eec82323 | 242 | |
16409b0b GM |
243 | (defun gnus-balloon-face-function (form type) |
244 | `(gnus-put-text-property | |
245 | (point) (progn ,@form (point)) | |
246 | 'balloon-help | |
247 | ,(intern (format "gnus-balloon-face-%d" type)))) | |
248 | ||
eec82323 LMI |
249 | (defun gnus-tilde-max-form (el max-width) |
250 | "Return a form that limits EL to MAX-WIDTH." | |
251 | (let ((max (abs max-width))) | |
252 | (if (symbolp el) | |
253 | `(if (> (length ,el) ,max) | |
254 | ,(if (< max-width 0) | |
255 | `(substring ,el (- (length el) ,max)) | |
256 | `(substring ,el 0 ,max)) | |
257 | ,el) | |
258 | `(let ((val (eval ,el))) | |
259 | (if (> (length val) ,max) | |
260 | ,(if (< max-width 0) | |
261 | `(substring val (- (length val) ,max)) | |
262 | `(substring val 0 ,max)) | |
263 | val))))) | |
264 | ||
265 | (defun gnus-tilde-cut-form (el cut-width) | |
266 | "Return a form that cuts CUT-WIDTH off of EL." | |
267 | (let ((cut (abs cut-width))) | |
268 | (if (symbolp el) | |
269 | `(if (> (length ,el) ,cut) | |
270 | ,(if (< cut-width 0) | |
271 | `(substring ,el 0 (- (length el) ,cut)) | |
272 | `(substring ,el ,cut)) | |
273 | ,el) | |
274 | `(let ((val (eval ,el))) | |
275 | (if (> (length val) ,cut) | |
276 | ,(if (< cut-width 0) | |
277 | `(substring val 0 (- (length val) ,cut)) | |
278 | `(substring val ,cut)) | |
279 | val))))) | |
280 | ||
281 | (defun gnus-tilde-ignore-form (el ignore-value) | |
282 | "Return a form that is blank when EL is IGNORE-VALUE." | |
283 | (if (symbolp el) | |
284 | `(if (equal ,el ,ignore-value) | |
285 | "" ,el) | |
286 | `(let ((val (eval ,el))) | |
287 | (if (equal val ,ignore-value) | |
288 | "" val)))) | |
289 | ||
290 | (defun gnus-parse-format (format spec-alist &optional insert) | |
291 | ;; This function parses the FORMAT string with the help of the | |
292 | ;; SPEC-ALIST and returns a list that can be eval'ed to return the | |
293 | ;; string. If the FORMAT string contains the specifiers %( and %) | |
294 | ;; the text between them will have the mouse-face text property. | |
16409b0b GM |
295 | ;; If the FORMAT string contains the specifiers %[ and %], the text between |
296 | ;; them will have the balloon-help text property. | |
eec82323 | 297 | (if (string-match |
16409b0b | 298 |