Mercurial > emacs
comparison lisp/gnus/gnus-spec.el @ 31716:9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Tue, 19 Sep 2000 13:37:09 +0000 |
parents | 15fc6acbae7a |
children | 1666541ea9be |
comparison
equal
deleted
inserted
replaced
31715:7c896543d225 | 31716:9968f55ad26e |
---|---|
1 ;;; gnus-spec.el --- format spec functions for Gnus | 1 ;;; gnus-spec.el --- format spec functions for Gnus |
2 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. | 2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000 |
3 ;; Free Software Foundation, Inc. | |
3 | 4 |
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | 5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
5 ;; Keywords: news | 6 ;; Keywords: news |
6 | 7 |
7 ;; This file is part of GNU Emacs. | 8 ;; This file is part of GNU Emacs. |
22 ;; Boston, MA 02111-1307, USA. | 23 ;; Boston, MA 02111-1307, USA. |
23 | 24 |
24 ;;; Commentary: | 25 ;;; Commentary: |
25 | 26 |
26 ;;; Code: | 27 ;;; Code: |
27 | |
28 (eval-when-compile (require 'cl)) | |
29 | 28 |
30 (eval-when-compile (require 'cl)) | 29 (eval-when-compile (require 'cl)) |
31 | 30 |
32 (require 'gnus) | 31 (require 'gnus) |
33 | 32 |
201 new-format | 200 new-format |
202 ;; This is a "real" format. | 201 ;; This is a "real" format. |
203 (gnus-parse-format | 202 (gnus-parse-format |
204 new-format | 203 new-format |
205 (symbol-value | 204 (symbol-value |
206 (intern (format "gnus-%s-line-format-alist" | 205 (intern (format "gnus-%s-line-format-alist" type))) |
207 (if (eq type 'article-mode) | |
208 'summary-mode type)))) | |
209 (not (string-match "mode$" (symbol-name type)))))) | 206 (not (string-match "mode$" (symbol-name type)))))) |
210 ;; Enter the new format spec into the list. | 207 ;; Enter the new format spec into the list. |
211 (if entry | 208 (if entry |
212 (progn | 209 (progn |
213 (setcar (cdr entry) val) | 210 (setcar (cdr entry) val) |
240 | 237 |
241 (defun gnus-face-face-function (form type) | 238 (defun gnus-face-face-function (form type) |
242 `(gnus-add-text-properties | 239 `(gnus-add-text-properties |
243 (point) (progn ,@form (point)) | 240 (point) (progn ,@form (point)) |
244 '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type)))))) | 241 '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type)))))) |
242 | |
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)))) | |
245 | 248 |
246 (defun gnus-tilde-max-form (el max-width) | 249 (defun gnus-tilde-max-form (el max-width) |
247 "Return a form that limits EL to MAX-WIDTH." | 250 "Return a form that limits EL to MAX-WIDTH." |
248 (let ((max (abs max-width))) | 251 (let ((max (abs max-width))) |
249 (if (symbolp el) | 252 (if (symbolp el) |
287 (defun gnus-parse-format (format spec-alist &optional insert) | 290 (defun gnus-parse-format (format spec-alist &optional insert) |
288 ;; This function parses the FORMAT string with the help of the | 291 ;; This function parses the FORMAT string with the help of the |
289 ;; SPEC-ALIST and returns a list that can be eval'ed to return the | 292 ;; SPEC-ALIST and returns a list that can be eval'ed to return the |
290 ;; string. If the FORMAT string contains the specifiers %( and %) | 293 ;; string. If the FORMAT string contains the specifiers %( and %) |
291 ;; the text between them will have the mouse-face text property. | 294 ;; the text between them will have the mouse-face text property. |
295 ;; If the FORMAT string contains the specifiers %[ and %], the text between | |
296 ;; them will have the balloon-help text property. | |
292 (if (string-match | 297 (if (string-match |
293 "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'" | 298 "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'" |
294 format) | 299 format) |
295 (gnus-parse-complex-format format spec-alist) | 300 (gnus-parse-complex-format format spec-alist) |
296 ;; This is a simple format. | 301 ;; This is a simple format. |
297 (gnus-parse-simple-format format spec-alist insert))) | 302 (gnus-parse-simple-format format spec-alist insert))) |
298 | 303 |
303 (goto-char (point-min)) | 308 (goto-char (point-min)) |
304 (while (re-search-forward "\"" nil t) | 309 (while (re-search-forward "\"" nil t) |
305 (replace-match "\\\"" nil t)) | 310 (replace-match "\\\"" nil t)) |
306 (goto-char (point-min)) | 311 (goto-char (point-min)) |
307 (insert "(\"") | 312 (insert "(\"") |
308 (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t) | 313 (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t) |
309 (let ((number (if (match-beginning 1) | 314 (let ((number (if (match-beginning 1) |
310 (match-string 1) "0")) | 315 (match-string 1) "0")) |
311 (delim (aref (match-string 2) 0))) | 316 (delim (aref (match-string 2) 0))) |
312 (if (or (= delim ?\() | 317 (if (or (= delim ?\() |
313 (= delim ?\{)) | 318 (= delim ?\{) |
314 (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") | 319 (= delim ?\«)) |
320 (replace-match (concat "\"(" | |
321 (cond ((= delim ?\() "mouse") | |
322 ((= delim ?\{) "face") | |
323 (t "balloon")) | |
315 " " number " \"")) | 324 " " number " \"")) |
316 (replace-match "\")\"")))) | 325 (replace-match "\")\"")))) |
317 (goto-char (point-max)) | 326 (goto-char (point-max)) |
318 (insert "\")") | 327 (insert "\")") |
319 (goto-char (point-min)) | 328 (goto-char (point-min)) |
390 (error "Unknown tilde type: %s" tilde))) | 399 (error "Unknown tilde type: %s" tilde))) |
391 t) | 400 t) |
392 (t | 401 (t |
393 nil))) | 402 nil))) |
394 ;; User-defined spec -- find the spec name. | 403 ;; User-defined spec -- find the spec name. |
395 (when (= (setq spec (following-char)) ?u) | 404 (when (eq (setq spec (char-after)) ?u) |
396 (forward-char 1) | 405 (forward-char 1) |
397 (setq user-defined (following-char))) | 406 (setq user-defined (char-after))) |
398 (forward-char 1) | 407 (forward-char 1) |
399 (delete-region spec-beg (point)) | 408 (delete-region spec-beg (point)) |
400 | 409 |
401 ;; Now we have all the relevant data on this spec, so | 410 ;; Now we have all the relevant data on this spec, so |
402 ;; we start doing stuff. | 411 ;; we start doing stuff. |
519 (when (and (listp form) | 528 (when (and (listp form) |
520 ;; Under GNU Emacs, it's (byte-code ...) | 529 ;; Under GNU Emacs, it's (byte-code ...) |
521 (not (eq 'byte-code (car form))) | 530 (not (eq 'byte-code (car form))) |
522 ;; Under XEmacs, it's (funcall #<compiled-function ...>) | 531 ;; Under XEmacs, it's (funcall #<compiled-function ...>) |
523 (not (and (eq 'funcall (car form)) | 532 (not (and (eq 'funcall (car form)) |
524 (compiled-function-p (cadr form))))) | 533 (byte-code-function-p (cadr form))))) |
525 (fset 'gnus-tmp-func `(lambda () ,form)) | 534 (fset 'gnus-tmp-func `(lambda () ,form)) |
526 (byte-compile 'gnus-tmp-func) | 535 (byte-compile 'gnus-tmp-func) |
527 (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))) | 536 (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))) |
528 | 537 |
529 (push (cons 'version emacs-version) gnus-format-specs) | 538 (push (cons 'version emacs-version) gnus-format-specs) |
535 (set (intern (format "gnus-%s-line-format-spec" type)) | 544 (set (intern (format "gnus-%s-line-format-spec" type)) |
536 (gnus-parse-format | 545 (gnus-parse-format |
537 (symbol-value (intern (format "gnus-%s-line-format" type))) | 546 (symbol-value (intern (format "gnus-%s-line-format" type))) |
538 (symbol-value (intern (format "gnus-%s-line-format-alist" type))) | 547 (symbol-value (intern (format "gnus-%s-line-format-alist" type))) |
539 insertable))) | 548 insertable))) |
540 | |
541 | 549 |
542 (provide 'gnus-spec) | 550 (provide 'gnus-spec) |
543 | 551 |
552 ;; Local Variables: | |
553 ;; coding: iso-8859-1 | |
554 ;; End: | |
555 | |
544 ;;; gnus-spec.el ends here | 556 ;;; gnus-spec.el ends here |