X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-spec.el;h=e1879202ef354210b70299f7f6eecb9496125448;hb=6910044663bc77081e08faabd6385cd34a9c8f5d;hp=8e019cc5fe523e97fbbd5ee8be1b9789b2e6ee14;hpb=385321f3ba46c87f52f7afd84c61788b4c66532e;p=gnus diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 8e019cc5f..e1879202e 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -1,45 +1,47 @@ ;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1996-2012 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; 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) (require 'gnus) (defcustom gnus-use-correct-string-widths (featurep 'xemacs) "*If non-nil, use correct functions for dealing with wide characters." - :version "21.4" + :version "22.1" :group 'gnus-format :type 'boolean) (defcustom gnus-make-format-preserve-properties (featurep 'xemacs) "*If non-nil, use a replacement `format' function which preserves -text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." - :version "21.4" +text properties. This is only needed on XEmacs, as Emacs does this anyway." + :version "22.1" :group 'gnus-format :type 'boolean) @@ -50,7 +52,7 @@ text properties. This is only needed on XEmacs, as FSF 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. @@ -85,6 +87,20 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." (defvar gnus-tmp-header) (defvar gnus-tmp-from) +(declare-function gnus-summary-from-or-to-or-newsgroups "gnus-sum" + (header gnus-tmp-from)) + +(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) + "")) + (defun gnus-summary-line-format-spec () (insert gnus-tmp-unread gnus-tmp-replied gnus-tmp-score-char gnus-tmp-indentation) @@ -98,7 +114,9 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)))) (if (> (length val) 23) - (substring val 0 23) + (if (gnus-lrm-string-p val) + (concat (substring val 0 23) gnus-lrm-string) + (substring val 0 23)) val)) gnus-tmp-closing-bracket)) (point)) @@ -248,11 +266,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 @@ -262,11 +299,30 @@ 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 @@ -295,9 +351,7 @@ Return a list of updated types." (defun gnus-correct-length (string) "Return the correct width of STRING." - (let ((length 0)) - (mapcar (lambda (char) (incf length (char-width char))) string) - length)) + (apply #'+ (mapcar #'char-width string))) (defun gnus-correct-substring (string start &optional end) (let ((wstart 0) @@ -348,13 +402,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) @@ -510,7 +568,7 @@ are supported for %s." (t (if (null args) (error 'wrong-number-of-arguments #'my-format n fstring)) - (let* ((minlen (string-to-int (or (match-string 2) ""))) + (let* ((minlen (string-to-number (or (match-string 2) ""))) (arg (car args)) (str (if (stringp arg) arg (format "%s" arg))) (lpad (null (match-string 1))) @@ -632,7 +690,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)) @@ -676,7 +734,7 @@ are supported for %s." ((string= fstring "%d") (setq dontinsert t) (if insert - (list `(princ ,(car flist))) + `(insert (int-to-string ,(car flist))) (list `(int-to-string ,(car flist))))) ;; Just lots of chars and strings. ((string-match "\\`\\(%[cs]\\)+\\'" fstring) @@ -763,5 +821,4 @@ If PROPS, insert the result." ;; coding: iso-8859-1 ;; End: -;;; arch-tag: a4328fa1-1f84-4b09-97ad-4b5767cfd50f ;;; gnus-spec.el ends here