X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-spec.el;h=4bf757187fe3311402bac3db4f8190507eeeeb40;hb=e380078b088aae5d92e9279997009dd6396129b2;hp=773e81352b85b1f0ea02493a61da5f37d32ac6d2;hpb=8ccf33808bd5c73ecb374f4d383fcb7906c3c2cb;p=gnus diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 773e81352..4bf757187 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -1,6 +1,7 @@ ;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -19,19 +20,28 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Code: (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 "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 "22.1" :group 'gnus-format :type 'boolean) @@ -130,7 +140,7 @@ (defvar gnus-format-specs `((version . ,emacs-version) (gnus-version . ,(gnus-continuum-version)) - (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) + (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" @@ -174,10 +184,11 @@ (pop-to-buffer "*Gnus Format*") (erase-buffer) (lisp-interaction-mode) - (insert (pp-to-string spec)))) + (insert (gnus-pp-to-string spec)))) (defun gnus-update-format-specifications (&optional force &rest types) - "Update all (necessary) format specifications." + "Update all (necessary) format specifications. +Return a list of updated types." ;; Make the indentation array. ;; See whether all the stored info needs to be flushed. (when (or force @@ -187,15 +198,22 @@ (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) + (let (new-format entry type val updated) (while (setq type (pop types)) ;; Jump to the proper buffer to find out the value of the ;; variable, if possible. (It may be buffer-local.) (save-excursion - (let ((buffer (intern (format "gnus-%s-buffer" type))) - val) + (let ((buffer (intern (format "gnus-%s-buffer" type)))) (when (and (boundp buffer) (setq val (symbol-value buffer)) (gnus-buffer-exists-p val)) @@ -225,10 +243,12 @@ (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))))) + (set (intern (format "gnus-%s-line-format-spec" type)) val) + (push type updated)))) - (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs))) + (unless (assq 'version gnus-format-specs) + (push (cons 'version emacs-version) gnus-format-specs)) + updated)) (defvar gnus-mouse-face-0 'highlight) (defvar gnus-mouse-face-1 'highlight) @@ -265,26 +285,20 @@ (defun gnus-spec-tab (column) (if (> column 0) - `(insert (make-string (max (- ,column (current-column)) 0) ? )) + `(insert-char ? (max (- ,column (current-column)) 0)) (let ((column (abs column))) - (if gnus-use-correct-string-widths - `(progn - (if (> (current-column) ,column) - (while (progn - (delete-backward-char 1) - (> (current-column) ,column)))) - (insert (make-string (max (- ,column (current-column)) 0) ? ))) - `(progn - (if (> (current-column) ,column) - (delete-region (point) - (- (point) (- (current-column) ,column))) - (insert (make-string (max (- ,column (current-column)) 0) - ? )))))))) + `(if (> (current-column) ,column) + (let ((end (point))) + (if (= (move-to-column ,column) ,column) + (delete-region (point) end) + (delete-region (1- (point)) end) + (insert " "))) + (insert-char ? (max (- ,column (current-column)) 0)))))) (defun gnus-correct-length (string) "Return the correct width of STRING." (let ((length 0)) - (mapcar (lambda (char) (incf length (gnus-char-width char))) string) + (mapcar (lambda (char) (incf length (char-width char))) string) length)) (defun gnus-correct-substring (string start &optional end) @@ -297,14 +311,14 @@ ;; Find the start position. (while (and (< seek length) (< wseek start)) - (incf wseek (gnus-char-width (aref string seek))) + (incf wseek (char-width (aref string seek))) (incf seek)) (setq wstart seek) ;; Find the end position. (while (and (<= seek length) (or (not end) (<= wseek end))) - (incf wseek (gnus-char-width (aref string seek))) + (incf wseek (char-width (aref string seek))) (incf seek)) (setq wend seek) (substring string wstart (1- wend)))) @@ -403,14 +417,14 @@ 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]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*\\*" format) (gnus-parse-complex-format format spec-alist) ;; This is a simple format. (gnus-parse-simple-format format spec-alist insert)))) (defun gnus-parse-complex-format (format spec-alist) - (let (found-C) + (let ((cursor-spec nil)) (save-excursion (gnus-set-work-buffer) (insert format) @@ -439,9 +453,9 @@ characters when given a pad value." ;; Convert point position commands. (goto-char (point-min)) (let ((case-fold-search nil)) - (while (re-search-forward "%\\([-0-9]+\\)?C" nil t) + (while (re-search-forward "%\\([-0-9]+\\)?\\*" nil t) (replace-match "\"(point)\"" t t) - (setq found-C t))) + (setq cursor-spec t))) ;; Convert TAB commands. (goto-char (point-min)) (while (re-search-forward "%\\([-0-9]+\\)=" nil t) @@ -449,7 +463,7 @@ characters when given a pad value." ;; Convert the buffer into the spec. (goto-char (point-min)) (let ((form (read (current-buffer)))) - (if found-C + (if cursor-spec `(let (gnus-position) ,@(gnus-complex-form-to-spec form spec-alist) (if gnus-position @@ -475,6 +489,41 @@ characters when given a pad value." (nth 1 sform))))) form))) + +(defun gnus-xmas-format (fstring &rest args) + "A version of `format' which preserves text properties. + +Required for XEmacs, where the built in `format' function strips all text +properties from both the format string and any inserted strings. + +Only supports the format sequence %s, and %% for inserting +literal % characters. A pad width and an optional - (to right pad) +are supported for %s." + (let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s") + (n (length args))) + (with-temp-buffer + (insert fstring) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (goto-char (match-end 0)) + (cond + ((string= (match-string 0) "%%") + (delete-char -1)) + (t + (if (null args) + (error 'wrong-number-of-arguments #'my-format n fstring)) + (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))) + (padlen (max 0 (- minlen (length str))))) + (replace-match "") + (if lpad (insert-char ?\ padlen)) + (insert str) + (unless lpad (insert-char ?\ padlen)) + (setq args (cdr args)))))) + (buffer-string)))) + (defun gnus-parse-simple-format (format spec-alist &optional insert) ;; 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 @@ -574,6 +623,9 @@ characters when given a pad value." ?s))) ;; Find the specification from `spec-alist'. ((setq elem (cdr (assq (or extended-spec spec) spec-alist)))) + ;; We used to use "%l" for displaying the grouplens score. + ((eq spec ?l) + (setq elem '("" ?s))) (t (setq elem '("*" ?s)))) (setq elem-type (cadr elem)) @@ -624,7 +676,7 @@ characters when given a pad value." (list (car flist))) ;; A single number. ((string= fstring "%d") - (setq dontinsert) + (setq dontinsert t) (if insert (list `(princ ,(car flist))) (list `(int-to-string ,(car flist))))) @@ -640,6 +692,13 @@ characters when given a pad value." ;; A single string spec in the end of the spec. ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) (list (match-string 1 fstring) (car flist))) + ;; Only string (and %) specs (XEmacs only!) + ((and (featurep 'xemacs) + gnus-make-format-preserve-properties + (string-match + "\\`\\([^%]*\\(%%\\|%-?\\([1-9][0-9]*\\)?s\\)\\)*[^%]*\\'" + fstring)) + (list (cons 'gnus-xmas-format (cons fstring (nreverse flist))))) ;; A more complex spec. (t (list (cons 'format (cons fstring (nreverse flist))))))) @@ -706,4 +765,5 @@ If PROPS, insert the result." ;; coding: iso-8859-1 ;; End: +;;; arch-tag: a4328fa1-1f84-4b09-97ad-4b5767cfd50f ;;; gnus-spec.el ends here