Mercurial > emacs

comparison lisp/gnus/gnus-spec.el @ 31716:9968f55ad26e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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