X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-spec.el;h=ca97b053c842c370edcdda129bb55e2f71f02f7b;hb=db4279b169d30aed36805cd3beb2cce20396c008;hp=4f3a1033b4e22d1fff2b72db3e8894f99f91aaeb;hpb=90cd1f789d04ff0dcbbec389745542b279324dff;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 4f3a103..ca97b05 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,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Katsumi Yamaoka ;; Keywords: news ;; This file is part of GNU Emacs. @@ -169,7 +170,10 @@ ;; See whether all the stored info needs to be flushed. (when (or force (not (equal emacs-version - (cdr (assq 'version gnus-format-specs))))) + (cdr (assq 'version gnus-format-specs)))) + (not (equal gnus-version + (cdr (assq 'gnus-version gnus-format-specs))))) + (message "%s" "Force update format specs.") (setq gnus-format-specs nil)) ;; Go through all the formats and see whether they need updating. @@ -201,9 +205,7 @@ (gnus-parse-format new-format (symbol-value - (intern (format "gnus-%s-line-format-alist" - (if (eq type 'article-mode) - 'summary-mode type)))) + (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 @@ -214,7 +216,9 @@ (set (intern (format "gnus-%s-line-format-spec" type)) val))))) (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs))) + (push (cons 'version emacs-version) gnus-format-specs)) + (unless (assq 'gnus-version gnus-format-specs) + (push (cons 'gnus-version gnus-version) gnus-format-specs))) (defvar gnus-mouse-face-0 'highlight) (defvar gnus-mouse-face-1 'highlight) @@ -239,8 +243,20 @@ (defun gnus-face-face-function (form type) `(gnus-add-text-properties (point) (progn ,@form (point)) - (list 'gnus-face t - 'face ',(symbol-value (intern (format "gnus-face-%d" type)))))) + '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type)))))) + +;;; Avoid byte-compile warning. +(defun gnus-tilde-pad-form (el pad-width) + "Dummy function except for XEmacs-mule. It will be redefined +by `gnus-xmas-redefine'." + (let ((val (if (symbolp el) (eval el) el))) + (` (, val)))) + +(defun gnus-balloon-face-function (form type) + `(gnus-put-text-property + (point) (progn ,@form (point)) + '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." @@ -288,8 +304,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,13 +322,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") + (= delim ?\{) + (= delim ?\<)) + (replace-match (concat "\"(" + (cond ((= delim ?\() "mouse") + ((= delim ?\{) "face") + (t "balloon")) " " number " \"")) (replace-match "\")\"")))) (goto-char (point-max)) @@ -334,7 +356,8 @@ ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return a ;; string. - (let ((max-width 0) + (let ((xemacs-mule-p (and gnus-xemacs (featurep 'mule))) + max-width spec flist fstring elem result dontinsert user-defined type value pad-width spec-beg cut-width ignore-value tilde-form tilde elem-type) @@ -342,7 +365,7 @@ (gnus-set-work-buffer) (insert format) (goto-char (point-min)) - (while (re-search-forward "%" nil t) + (while (search-forward "%" nil t) (setq user-defined nil spec-beg nil pad-width nil @@ -391,9 +414,9 @@ (t nil))) ;; User-defined spec -- find the spec name. - (when (= (setq spec (following-char)) ?u) + (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)) @@ -421,10 +444,11 @@ (setq elem '("*" ?s)))) (setq elem-type (cadr elem)) ;; Insert the new format elements. - (when pad-width - (insert (number-to-string pad-width))) + (and pad-width (not xemacs-mule-p) + (insert (number-to-string pad-width))) ;; Create the form to be evaled. - (if (or max-width cut-width ignore-value) + (if (or max-width cut-width ignore-value + (and pad-width xemacs-mule-p)) (progn (insert ?s) (let ((el (car elem))) @@ -438,6 +462,8 @@ (setq el (gnus-tilde-cut-form el cut-width))) (when max-width (setq el (gnus-tilde-max-form el max-width))) + (and pad-width xemacs-mule-p + (setq el (gnus-tilde-pad-form el pad-width))) (push el flist))) (insert elem-type) (push (car elem) flist)))) @@ -520,14 +546,14 @@ If PROPS, insert the result." (not (eq 'byte-code (car form))) ;; Under XEmacs, it's (funcall #) (not (and (eq 'funcall (car form)) - (compiled-function-p (cadr form))))) + (byte-code-function-p (cadr form))))) (fset '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) @@ -536,7 +562,7 @@ If PROPS, insert the result." (symbol-value (intern (format "gnus-%s-line-format" type))) (symbol-value (intern (format "gnus-%s-line-format-alist" type))) insertable))) - + (provide 'gnus-spec)