-;;; gnus-spec.el --- format spec functions for Gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;;; gnus-spec.el --- format spec functions for Gnus -*- coding: iso-latin-1 -*-
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(require 'gnus)
+(defcustom gnus-use-correct-string-widths t
+ "*If non-nil, use correct functions for dealing with wide characters."
+ :group 'gnus-format
+ :type 'boolean)
+
;;; Internal variables.
(defvar gnus-summary-mark-positions nil)
(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)
(summary-dummy "* %(: :%) %S\n"
,gnus-summary-dummy-line-format-spec)
- (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ (summary "%U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n"
,gnus-summary-line-format-spec))
"Alist of format specs.")
(defvar gnus-summary-mode-line-format-spec nil)
(defvar gnus-group-mode-line-format-spec nil)
-;;; Phew. All that gruft is over, fortunately.
+;;; Phew. All that gruft is over with, fortunately.
;;;###autoload
(defun gnus-update-format (var)
;; Make the indentation array.
;; See whether all the stored info needs to be flushed.
(when (or force
+ (not (equal (gnus-continuum-version)
+ (cdr (assq 'gnus-version gnus-format-specs))))
(not (equal emacs-version
(cdr (assq 'version gnus-format-specs)))))
(setq gnus-format-specs nil))
;; Go through all the formats and see whether they need updating.
(let (new-format entry type val)
(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.)
+ ;; 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)
'balloon-help
,(intern (format "gnus-balloon-face-%d" type))))
+(defun gnus-spec-tab (column)
+ (if (> column 0)
+ `(insert (make-string (max (- ,column (current-column)) 0) ? ))
+ `(progn
+ (if (> (current-column) ,(abs column))
+ (delete-region (point)
+ (- (point) (- (current-column) ,(abs column))))
+ (insert (make-string (max (- ,(abs 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)
+ length))
+
+(defun gnus-correct-substring (string start &optional end)
+ (let ((wstart 0)
+ (wend 0)
+ (seek 0)
+ (length (length string)))
+ ;; Find the start position.
+ (while (and (< seek length)
+ (< wstart start))
+ (incf wstart (gnus-char-width (aref string seek)))
+ (incf seek))
+ (setq wend wstart
+ wstart seek)
+ ;; Find the end position.
+ (while (and (< seek length)
+ (or (not end)
+ (<= wend end)))
+ (incf wend (gnus-char-width (aref string seek)))
+ (incf seek))
+ (setq wend seek)
+ (substring string wstart (1- wend))))
+
(defun gnus-tilde-max-form (el max-width)
"Return a form that limits EL to MAX-WIDTH."
(let ((max (abs max-width)))
(if (symbolp el)
- `(if (> (length ,el) ,max)
+ `(if (> (,(if gnus-use-correct-string-widths
+ 'gnus-correct-length
+ 'length) ,el)
+ ,max)
,(if (< max-width 0)
- `(substring ,el (- (length el) ,max))
- `(substring ,el 0 ,max))
+ `(,(if gnus-use-correct-string-widths
+ 'gnus-correct-substring
+ 'substring)
+ ,el (- (,(if gnus-use-correct-string-widths
+ 'gnus-correct-length
+ 'length)
+ el) ,max))
+ `(,(if gnus-use-correct-string-widths
+ 'gnus-correct-substring
+ 'substring)
+ ,el 0 ,max))
,el)
`(let ((val (eval ,el)))
- (if (> (length val) ,max)
+ (if (> (,(if gnus-use-correct-string-widths
+ 'gnus-correct-length
+ 'length) val) ,max)
,(if (< max-width 0)
- `(substring val (- (length val) ,max))
- `(substring val 0 ,max))
+ `(,(if gnus-use-correct-string-widths
+ 'gnus-correct-substring
+ 'substring)
+ val (- (,(if gnus-use-correct-string-widths
+ 'gnus-correct-length
+ 'length) val) ,max))
+ `(,(if gnus-use-correct-string-widths
+ 'gnus-correct-substring
+ 'substring)
+ val 0 ,max))
val)))))
(defun gnus-tilde-cut-form (el cut-width)
"Return a form that cuts CUT-WIDTH off of EL."
(let ((cut (abs cut-width)))
(if (symbolp el)
- `(if (> (length ,el) ,cut)
+ `(if (> (,(if gnus-use-correct-string-widths
+ 'gnus-correct-length
+ 'length) ,el) ,cut)
,(if (< cut-width 0)
- `(substring ,el 0 (- (length el) ,cut))
- `(substring ,el ,cut))
+ `(,(if gnus-use-correct-string-widths
+ 'gnus-correct-substring
+ 'substring) ,el 0
+ (- (,(if gnus-use-correct-string-widths
+ 'gnus-correct-length
+ 'length) el) ,cut))
+ `(,(if gnus-use-correct-string-widths
+ 'gnus-correct-substring
+ 'substring) ,el ,cut))
,el)
`(let ((val (eval ,el)))
- (if (> (length val) ,cut)
+ (if (> (,(if gnus-use-correct-string-widths
+ 'gnus-correct-length
+ 'length) val) ,cut)
,(if (< cut-width 0)
- `(substring val 0 (- (length val) ,cut))
- `(substring val ,cut))
+ `(,(if gnus-use-correct-string-widths
+ 'gnus-correct-substring
+ 'substring) val 0
+ (- (,(if gnus-use-correct-string-widths
+ 'gnus-correct-length
+ 'length) val) ,cut))
+ `(,(if gnus-use-correct-string-widths
+ 'gnus-correct-substring
+ 'substring) val ,cut))
val)))))
(defun gnus-tilde-ignore-form (el ignore-value)
(replace-match "\\\"" nil t))
(goto-char (point-min))
(insert "(\"")
+ ;; Convert all font specs into font spec lists.
(while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t)
(let ((number (if (match-beginning 1)
(match-string 1) "0"))
(cond ((= delim ?\() "mouse")
((= delim ?\{) "face")
(t "balloon"))
- " " number " \""))
+ " " number " \"")
+ t t)
(replace-match "\")\""))))
(goto-char (point-max))
(insert "\")")
+ ;; Convert point position commands.
+ (goto-char (point-min))
+ (while (re-search-forward "%\\([-0-9]+\\)?C" nil t)
+ (replace-match "\"(point)\"" t t))
+ ;; Convert TAB commands.
+ (goto-char (point-min))
+ (while (re-search-forward "%\\([-0-9]+\\)=" nil t)
+ (replace-match (format "\"(tab %s)\"" (match-string 1)) t t))
+ ;; Convert the buffer into the spec.
(goto-char (point-min))
(let ((form (read (current-buffer))))
+ ;; If the first element is '(point), we just remove it.
+ (when (equal (car form) '(point))
+ (pop form))
(cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
(defun gnus-complex-form-to-spec (form spec-alist)
(delq nil
(mapcar
(lambda (sform)
- (if (stringp sform)
- (gnus-parse-simple-format sform spec-alist t)
+ (cond
+ ((stringp sform)
+ (gnus-parse-simple-format sform spec-alist t))
+ ((eq (car sform) 'point)
+ `(gnus-put-text-property (1- (point)) (point) 'gnus-position t))
+ ((eq (car sform) 'tab)
+ (gnus-spec-tab (cadr sform)))
+ (t
(funcall (intern (format "gnus-%s-face-function" (car sform)))
(gnus-complex-form-to-spec (cddr sform) spec-alist)
- (nth 1 sform))))
+ (nth 1 sform)))))
form)))
(defun gnus-parse-simple-format (format spec-alist &optional insert)
(while entries
(setq entry (pop entries))
- (if (eq (car entry) 'version)
+ (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 XEmacs, it's (funcall #<compiled-function ...>)
(not (and (eq 'funcall (car form))
(byte-code-function-p (cadr form)))))
- (fset 'gnus-tmp-func `(lambda () ,form))
+ (defalias 'gnus-tmp-func `(lambda () ,form))
(byte-compile 'gnus-tmp-func)
(setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))))