;;; 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 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; 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)
(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"
(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
(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))
(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)
(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)
;; 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))))
;; 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)
;; 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)
;; 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
(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
?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))
(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)))))
;; 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)))))))
;; coding: iso-8859-1
;; End:
+;;; arch-tag: a4328fa1-1f84-4b09-97ad-4b5767cfd50f
;;; gnus-spec.el ends here