X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-spec.el;h=e11ddc4c4f5be4e90ecc656e586402289880ab9d;hb=2ec37f63143ecc8adf5054974df68062c5498e75;hp=4682f512476c448a123272a0458d6cf51f3fae9d;hpb=4c2a7a1c25d5b10316f35f28c972ef3e70225f25;p=gnus diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 4682f5124..e11ddc4c4 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -1,6 +1,6 @@ ;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996-2011 Free Software Foundation, Inc. +;; Copyright (C) 1996-2014 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -24,9 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (defvar gnus-newsrc-file-version) @@ -52,7 +49,7 @@ text properties. This is only needed on XEmacs, as Emacs does this anyway." (defvar gnus-group-indentation "") ;; Format specs. The chunks below are the machine-generated forms -;; that are to be evaled as the result of the default format strings. +;; that are to be evalled as the result of the default format strings. ;; We write them in here to get them byte-compiled. That way the ;; default actions will be quite fast, while still retaining the full ;; flexibility of the user-defined format specs. @@ -81,7 +78,6 @@ text properties. This is only needed on XEmacs, as Emacs does this anyway." (defvar gnus-tmp-unread-and-unselected) (defvar gnus-tmp-news-method) (defvar gnus-tmp-news-server) -(defvar gnus-tmp-article-number) (defvar gnus-mouse-face) (defvar gnus-mouse-face-prop) (defvar gnus-tmp-header) @@ -90,64 +86,24 @@ text properties. This is only needed on XEmacs, as Emacs does this anyway." (declare-function gnus-summary-from-or-to-or-newsgroups "gnus-sum" (header gnus-tmp-from)) -(defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (gnus-put-text-property - (point) - (progn - (insert - (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines - (let ((val - (inline - (gnus-summary-from-or-to-or-newsgroups - gnus-tmp-header gnus-tmp-from)))) - (if (> (length val) 23) - (substring val 0 23) - val)) - gnus-tmp-closing-bracket)) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n")) - -(defvar gnus-summary-line-format-spec - (gnus-byte-code 'gnus-summary-line-format-spec)) - -(defun gnus-summary-dummy-line-format-spec () - (insert "* ") - (gnus-put-text-property - (point) - (progn - (insert ": :") - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject "\n")) - -(defvar gnus-summary-dummy-line-format-spec - (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) - -(defun gnus-group-line-format-spec () - (insert gnus-tmp-marked-mark gnus-tmp-subscribed - gnus-tmp-process-marked - gnus-group-indentation - (format "%5s: " gnus-tmp-number-of-unread)) - (gnus-put-text-property - (point) - (progn - (insert gnus-tmp-group "\n") - (1- (point))) - gnus-mouse-face-prop gnus-mouse-face)) -(defvar gnus-group-line-format-spec - (gnus-byte-code 'gnus-group-line-format-spec)) +(defmacro gnus-lrm-string-p (string) + (if (fboundp 'bidi-string-mark-left-to-right) + ;; LRM, RLM, PDF characters as integers to avoid breaking Emacs + ;; 23. + `(memq (aref ,string (1- (length ,string))) '(8206 8207 8236)) + nil)) + +(defvar gnus-lrm-string (if (ignore-errors (string 8206)) + (propertize (string 8206) 'invisible t) + "")) + +(defvar gnus-summary-line-format-spec nil) +(defvar gnus-summary-dummy-line-format-spec nil) +(defvar gnus-group-line-format-spec nil) (defvar gnus-format-specs `((version . ,emacs-version) - (gnus-version . ,(gnus-continuum-version)) - (group "%M\%S\%p\%P\%5y: %(%g%)\n" ,gnus-group-line-format-spec) - (summary-dummy "* %(: :%) %S\n" - ,gnus-summary-dummy-line-format-spec) - (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" - ,gnus-summary-line-format-spec)) + (gnus-version . ,(gnus-continuum-version))) "Alist of format specs.") (defvar gnus-default-format-specs gnus-format-specs) @@ -201,15 +157,6 @@ Return a list of updated types." (not (equal emacs-version (cdr (assq 'version gnus-format-specs))))) (setq gnus-format-specs nil)) - ;; Flush the group format spec cache if there's the grouplens stuff - ;; or it doesn't support decoded group names. - (when (memq 'group types) - (let* ((spec (assq 'group gnus-format-specs)) - (sspec (gnus-prin1-to-string (nth 2 spec)))) - (when (or (string-match " gnus-tmp-grouplens[ )]" sspec) - (not (string-match " gnus-tmp-decoded-group[ )]" sspec))) - (setq gnus-format-specs (delq spec gnus-format-specs))))) - ;; Go through all the formats and see whether they need updating. (let (new-format entry type val updated) (while (setq type (pop types)) @@ -253,11 +200,30 @@ Return a list of updated types." (push (cons 'version emacs-version) gnus-format-specs)) updated)) -(defvar gnus-mouse-face-0 'highlight) -(defvar gnus-mouse-face-1 'highlight) -(defvar gnus-mouse-face-2 'highlight) -(defvar gnus-mouse-face-3 'highlight) -(defvar gnus-mouse-face-4 'highlight) +(defcustom gnus-mouse-face-0 'highlight + "The \"%(hello%)\" face." + :group 'gnus-format + :type 'face) + +(defcustom gnus-mouse-face-1 'highlight + "The \"%1(hello%)\" face." + :group 'gnus-format + :type 'face) + +(defcustom gnus-mouse-face-2 'highlight + "The \"%2(hello%)\" face." + :group 'gnus-format + :type 'face) + +(defcustom gnus-mouse-face-3 'highlight + "The \"%3(hello%)\" face." + :group 'gnus-format + :type 'face) + +(defcustom gnus-mouse-face-4 'highlight + "The \"%4(hello%)\" face." + :group 'gnus-format + :type 'face) (defun gnus-mouse-face-function (form type) `(gnus-put-text-property @@ -267,16 +233,42 @@ Return a list of updated types." 'gnus-mouse-face `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) -(defvar gnus-face-0 'bold) -(defvar gnus-face-1 'italic) -(defvar gnus-face-2 'bold-italic) -(defvar gnus-face-3 'bold) -(defvar gnus-face-4 'bold) +(defcustom gnus-face-0 'bold + "The \"%{hello%}\" face." + :group 'gnus-format + :type 'face) + +(defcustom gnus-face-1 'italic + "The \"%1{hello%}\" face." + :group 'gnus-format + :type 'face) + +(defcustom gnus-face-2 'bold-italic + "The \"%2{hello%}\" face." + :group 'gnus-format + :type 'face) + +(defcustom gnus-face-3 'bold + "The \"%3{hello%}\" face." + :group 'gnus-format + :type 'face) + +(defcustom gnus-face-4 'bold + "The \"%4{hello%}\" face." + :group 'gnus-format + :type 'face) (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)))))) + (cons 'face + (cons + ;; Delay consing the value of the `face' property until + ;; `gnus-add-text-properties' runs, since it will be modified + ;; by `gnus-put-text-property-excluding-characters-with-faces'. + (list ',(symbol-value (intern (format "gnus-face-%d" type))) 'default) + ;; Redundant now, but still convenient. + '(gnus-face t))))) (defun gnus-balloon-face-function (form type) `(gnus-put-text-property @@ -351,13 +343,17 @@ Return a list of updated types." `(if (> (,length-fun ,el) ,max) ,(if (< max-width 0) `(,substring-fun ,el (- (,length-fun ,el) ,max)) - `(,substring-fun ,el 0 ,max)) + `(if (gnus-lrm-string-p ,el) + (concat (,substring-fun ,el 0 ,max) ,gnus-lrm-string) + (,substring-fun ,el 0 ,max))) ,el) `(let ((val (eval ,el))) (if (> (,length-fun val) ,max) ,(if (< max-width 0) `(,substring-fun val (- (,length-fun val) ,max)) - `(,substring-fun val 0 ,max)) + `(if (gnus-lrm-string-p val) + (concat (,substring-fun val 0 ,max) ,gnus-lrm-string) + (,substring-fun val 0 ,max))) val))))) (defun gnus-tilde-cut-form (el cut-width) @@ -418,7 +414,7 @@ characters when given a pad value." ;; them will have the balloon-help text property. (let ((case-fold-search nil)) (if (string-match - "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*\\*" + "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*\\*" format) (gnus-parse-complex-format format spec-alist) ;; This is a simple format. @@ -435,13 +431,13 @@ characters when given a pad value." (goto-char (point-min)) (insert "(\"") ;; Convert all font specs into font spec lists. - (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 ?\{) - (= delim ?\«)) + (= delim 171)) ; « (replace-match (concat "\"(" (cond ((= delim ?\() "mouse") ((= delim ?\{) "face") @@ -512,7 +508,8 @@ are supported for %s." (delete-char -1)) (t (if (null args) - (error 'wrong-number-of-arguments #'my-format n fstring)) + (signal 'wrong-number-of-arguments + (list #'gnus-xmas-format n fstring))) (let* ((minlen (string-to-number (or (match-string 2) ""))) (arg (car args)) (str (if (stringp arg) arg (format "%s" arg))) @@ -635,7 +632,7 @@ are supported for %s." (not (and (featurep 'xemacs) gnus-use-correct-string-widths))) (insert (number-to-string pad-width))) - ;; Create the form to be evaled. + ;; Create the form to be evalled. (if (or max-width cut-width ignore-value (and (featurep 'xemacs) gnus-use-correct-string-widths)) @@ -723,36 +720,6 @@ If PROPS, insert the result." (gnus-add-text-properties (point) (progn (eval form) (point)) props) (eval form)))) -(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) - (save-excursion - (gnus-message 7 "Compiling format specs...") - - (while entries - (setq entry (pop entries)) - (if (memq (car entry) '(gnus-version version)) - (setq gnus-format-specs (delq entry gnus-format-specs)) - (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-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 @@ -763,7 +730,7 @@ If PROPS, insert the result." (provide 'gnus-spec) ;; Local Variables: -;; coding: iso-8859-1 +;; coding: utf-8 ;; End: ;;; gnus-spec.el ends here