X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-spec.el;h=340801ca4207859cd212e630aa7f0eeda038e32a;hb=c7fe7899bca156591013b0f833d601f9f5d6e9c9;hp=07d1a87df2fc01a629d18817933b36692779c9ef;hpb=178fc161c59aebf50ba3042c6aecb56888cb4d49;p=gnus diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 07d1a87df..340801ca4 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -1,4 +1,4 @@ -;;; gnus-spec.el --- format spec functions for Gnus +;;; gnus-spec.el --- format spec functions for Gnus -*- coding: iso-latin-1 -*- ;; Copyright (C) 1996, 1997, 1998, 1999, 2000 ;; Free Software Foundation, Inc. @@ -30,6 +30,11 @@ (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) @@ -120,10 +125,11 @@ (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.") @@ -131,7 +137,7 @@ (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) @@ -169,6 +175,8 @@ ;; 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)) @@ -176,8 +184,8 @@ ;; 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) @@ -246,36 +254,113 @@ '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) @@ -310,6 +395,7 @@ (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")) @@ -321,23 +407,42 @@ (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) @@ -522,7 +627,7 @@ If PROPS, insert the result." (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) @@ -531,7 +636,7 @@ If PROPS, insert the result." ;; Under XEmacs, it's (funcall #) (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))))))