X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-spec.el;h=3878b8ad372456e41c159742e178f7f76f89decd;hb=0651fabaac80cf08698f066dae0af33f29b91a9a;hp=4d8086f80fd3ee17bd9fc316ca5a81043e4669a1;hpb=4b41275525751899e167289322e192b3c0db35b9;p=gnus diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 4d8086f80..3878b8ad3 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -1,7 +1,8 @@ ;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -25,7 +26,8 @@ ;;; Code: -(require 'gnus-load) +(eval-when-compile (require 'cl)) + (require 'gnus) ;;; Internal variables. @@ -116,12 +118,12 @@ (defvar gnus-group-line-format-spec (gnus-byte-code 'gnus-group-line-format-spec)) -(defvar gnus-format-specs +(defvar gnus-format-specs `((version . ,emacs-version) (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) (summary-dummy "* %(: :%) %S\n" ,gnus-summary-dummy-line-format-spec) - (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" + (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" ,gnus-summary-line-format-spec)) "Alist of format specs.") @@ -165,7 +167,6 @@ (defun gnus-update-format-specifications (&optional force &rest types) "Update all (necessary) format specifications." ;; Make the indentation array. - ;; See whether all the stored info needs to be flushed. (when (or force (not (equal emacs-version @@ -182,37 +183,34 @@ val) (when (and (boundp buffer) (setq val (symbol-value buffer)) - (get-buffer val) - (buffer-name (get-buffer val))) - (set-buffer (get-buffer val))) + (gnus-buffer-exists-p val)) + (set-buffer val)) (setq new-format (symbol-value - (intern (format "gnus-%s-line-format" type)))))) - (setq entry (cdr (assq type gnus-format-specs))) - (if (and entry - (equal (car entry) new-format)) - ;; Use the old format. - (set (intern (format "gnus-%s-line-format-spec" type)) - (cadr entry)) - ;; This is a new format. - (setq val - (if (not (stringp new-format)) - ;; This is a function call or something. - new-format - ;; This is a "real" format. - (gnus-parse-format - new-format - (symbol-value - (intern (format "gnus-%s-line-format-alist" - (if (eq type 'article-mode) - 'summary-mode type)))) - (not (string-match "mode$" (symbol-name type)))))) - ;; Enter the new format spec into the list. - (if entry - (progn - (setcar (cdr entry) val) - (setcar entry new-format)) - (push (list type new-format val) gnus-format-specs)) - (set (intern (format "gnus-%s-line-format-spec" type)) val)))) + (intern (format "gnus-%s-line-format" type))))) + (setq entry (cdr (assq type gnus-format-specs))) + (if (and (car entry) + (equal (car entry) new-format)) + ;; Use the old format. + (set (intern (format "gnus-%s-line-format-spec" type)) + (cadr entry)) + ;; This is a new format. + (setq val + (if (not (stringp new-format)) + ;; This is a function call or something. + new-format + ;; This is a "real" format. + (gnus-parse-format + new-format + (symbol-value + (intern (format "gnus-%s-line-format-alist" type))) + (not (string-match "mode$" (symbol-name type)))))) + ;; Enter the new format spec into the list. + (if entry + (progn + (setcar (cdr entry) val) + (setcar entry new-format)) + (push (list type new-format val) gnus-format-specs)) + (set (intern (format "gnus-%s-line-format-spec" type)) val))))) (unless (assq 'version gnus-format-specs) (push (cons 'version emacs-version) gnus-format-specs))) @@ -238,9 +236,15 @@ (defvar gnus-face-4 'bold) (defun gnus-face-face-function (form type) + `(gnus-add-text-properties + (point) (progn ,@form (point)) + '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type)))))) + +(defun gnus-balloon-face-function (form type) `(gnus-put-text-property (point) (progn ,@form (point)) - 'face ',(symbol-value (intern (format "gnus-face-%d" type))))) + 'balloon-help + ,(intern (format "gnus-balloon-face-%d" type)))) (defun gnus-tilde-max-form (el max-width) "Return a form that limits EL to MAX-WIDTH." @@ -271,7 +275,7 @@ (if (> (length val) ,cut) ,(if (< cut-width 0) `(substring val 0 (- (length val) ,cut)) - `(substring val 0 ,cut)) + `(substring val ,cut)) val))))) (defun gnus-tilde-ignore-form (el ignore-value) @@ -288,8 +292,10 @@ ;; SPEC-ALIST and returns a list that can be eval'ed to return the ;; string. If the FORMAT string contains the specifiers %( and %) ;; the text between them will have the mouse-face text property. + ;; If the FORMAT string contains the specifiers %[ and %], the text between + ;; them will have the balloon-help text property. (if (string-match - "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'" + "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'" format) (gnus-parse-complex-format format spec-alist) ;; This is a simple format. @@ -304,12 +310,17 @@ (replace-match "\\\"" nil t)) (goto-char (point-min)) (insert "(\"") - (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t) + (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t) (let ((number (if (match-beginning 1) (match-string 1) "0")) (delim (aref (match-string 2) 0))) - (if (or (= delim ?\() (= delim ?\{)) - (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") + (if (or (= delim ?\() + (= delim ?\{) + (= delim ?\«)) + (replace-match (concat "\"(" + (cond ((= delim ?\() "mouse") + ((= delim ?\{) "face") + (t "balloon")) " " number " \"")) (replace-match "\")\"")))) (goto-char (point-max)) @@ -353,7 +364,7 @@ ;; Parse this spec fully. (while - (cond + (cond ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?") (setq pad-width (string-to-number (match-string 1))) (when (match-beginning 2) @@ -389,9 +400,10 @@ t) (t nil))) - (when (= (setq spec (following-char)) ?u) + ;; User-defined spec -- find the spec name. + (when (eq (setq spec (char-after)) ?u) (forward-char 1) - (setq user-defined (following-char))) + (setq user-defined (char-after))) (forward-char 1) (delete-region spec-beg (point)) @@ -411,7 +423,8 @@ (list (list (intern (format "gnus-user-format-function-%c" user-defined)) - 'gnus-tmp-header) ?s))) + 'gnus-tmp-header) + ?s))) ;; Find the specification from `spec-alist'. ((setq elem (cdr (assq spec spec-alist)))) (t @@ -439,7 +452,7 @@ (insert elem-type) (push (car elem) flist)))) (setq fstring (buffer-string))) - + ;; Do some postprocessing to increase efficiency. (setq result @@ -500,6 +513,7 @@ If PROPS, insert the result." (defun gnus-compile () "Byte-compile the user-defined format specs." (interactive) + (require 'bytecomp) (let ((entries gnus-format-specs) (byte-compile-warnings '(unresolved callargs redefine)) entry gnus-tmp-func) @@ -510,17 +524,33 @@ If PROPS, insert the result." (setq entry (pop entries)) (if (eq (car entry) 'version) (setq gnus-format-specs (delq entry gnus-format-specs)) - (when (and (listp (caddr entry)) - (not (eq 'byte-code (caaddr entry)))) - (fset 'gnus-tmp-func `(lambda () ,(caddr entry))) - (byte-compile 'gnus-tmp-func) - (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) + (let ((form (caddr entry))) + (when (and (listp form) + ;; Under GNU Emacs, it's (byte-code ...) + (not (eq 'byte-code (car form))) + ;; Under XEmacs, it's (funcall #) + (not (and (eq 'funcall (car form)) + (byte-code-function-p (cadr form))))) + (defalias 'gnus-tmp-func `(lambda () ,form)) + (byte-compile 'gnus-tmp-func) + (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))) (push (cons 'version emacs-version) gnus-format-specs) ;; Mark the .newsrc.eld file as "dirty". - (gnus-dribble-enter " ") + (gnus-dribble-touch) (gnus-message 7 "Compiling user specs...done")))) +(defun gnus-set-format (type &optional insertable) + (set (intern (format "gnus-%s-line-format-spec" type)) + (gnus-parse-format + (symbol-value (intern (format "gnus-%s-line-format" type))) + (symbol-value (intern (format "gnus-%s-line-format-alist" type))) + insertable))) + (provide 'gnus-spec) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; gnus-spec.el ends here