-;;; gnus-spec.el --- format spec functions for Gnus
-;; Copyright (C) 1996,97,98 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)
(gnus-parse-format
new-format
(symbol-value
- (intern (format "gnus-%s-line-format-alist"
- (if (eq type 'article-mode)
- 'summary-mode type))))
+ (intern (format "gnus-%s-line-format-alist" type)))
(not (string-match "mode$" (symbol-name type))))))
;; Enter the new format spec into the list.
(if entry
(defvar gnus-face-4 'bold)
(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))))))
+
+(defun gnus-balloon-face-function (form type)
`(gnus-put-text-property
(point) (progn ,@form (point))
- 'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
+ '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)
;; SPEC-ALIST and returns a list that can be eval'ed to return the
;; string. If the FORMAT string contains the specifiers %( and %)
;; the text between them will have the mouse-face text property.
+ ;; If the FORMAT string contains the specifiers %[ and %], the text between
+ ;; them will have the balloon-help text property.
(if (string-match
- "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
+ "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'"
format)
(gnus-parse-complex-format format spec-alist)
;; This is a simple format.
(replace-match "\\\"" nil t))
(goto-char (point-min))
(insert "(\"")
- (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
+ ;; 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"))
(delim (aref (match-string 2) 0)))
- (if (or (= delim ?\() (= delim ?\{))
- (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
- " " number " \""))
+ (if (or (= delim ?\()
+ (= delim ?\{)
+ (= delim ?\«))
+ (replace-match (concat "\"("
+ (cond ((= delim ?\() "mouse")
+ ((= delim ?\{) "face")
+ (t "balloon"))
+ " " 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)
(t
nil)))
;; User-defined spec -- find the spec name.
- (when (= (setq spec (following-char)) ?u)
+ (when (eq (setq spec (char-after)) ?u)
(forward-char 1)
- (setq user-defined (following-char)))
+ (setq user-defined (char-after)))
(forward-char 1)
(delete-region spec-beg (point))
(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)
(not (eq 'byte-code (car form)))
;; Under XEmacs, it's (funcall #<compiled-function ...>)
(not (and (eq 'funcall (car form))
- (compiled-function-p (cadr form)))))
- (fset 'gnus-tmp-func `(lambda () ,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-enter " ")
+ (gnus-dribble-touch)
(gnus-message 7 "Compiling user specs...done"))))
(defun gnus-set-format (type &optional insertable)
(symbol-value (intern (format "gnus-%s-line-format" type)))
(symbol-value (intern (format "gnus-%s-line-format-alist" type)))
insertable)))
-
(provide 'gnus-spec)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; gnus-spec.el ends here
projects / gnus / blobdiff