(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)
;; 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)
(mapcar (lambda (char) (incf length (gnus-char-width char))) string)
length))
-(defun gnus-correct-substring (string start end)
+(defun gnus-correct-substring (string start &optional end)
(let ((wstart 0)
(wend 0)
+ (wseek 0)
(seek 0)
- (length (length string)))
+ (length (length string))
+ (string (concat string "\0")))
;; Find the start position.
(while (and (< seek length)
- (< wstart start))
- (incf wstart (gnus-char-width (aref string seek)))
+ (< wseek start))
+ (incf wseek (gnus-char-width (aref string seek)))
(incf seek))
- (setq wend wstart
- wstart seek)
+ (setq wstart seek)
;; Find the end position.
- (while (and (< seek length)
- (<= wend end))
- (incf wend (gnus-char-width (aref string seek)))
+ (while (and (<= seek length)
+ (or (not end)
+ (<= wseek end)))
+ (incf wseek (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 (> (,(if gnus-use-correct-string-widths
+ (let ((max (abs max-width))
+ (length-fun (if gnus-use-correct-string-widths
'gnus-correct-length
- 'length) ,el)
- ,max)
- ,(if (< max-width 0)
- `(,(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
+ 'length))
+ (substring-fun (if gnus-use-correct-string-widths
'gnus-correct-substring
- 'substring)
- ,el 0 ,max))
+ 'substring)))
+ (if (symbolp el)
+ `(if (> (,length-fun ,el) ,max)
+ ,(if (< max-width 0)
+ `(,substring-fun ,el (- (,length-fun ,el) ,max))
+ `(,substring-fun ,el 0 ,max))
,el)
`(let ((val (eval ,el)))
- (if (> (,(if gnus-use-correct-string-widths
- 'gnus-correct-length
- 'length) val) ,max)
+ (if (> (,length-fun val) ,max)
,(if (< max-width 0)
- `(,(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))
+ `(,substring-fun val (- (,length-fun val) ,max))
+ `(,substring-fun 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 (> (,(if gnus-use-correct-string-widths
+ (let ((cut (abs cut-width))
+ (length-fun (if gnus-use-correct-string-widths
'gnus-correct-length
- 'length) ,el) ,cut)
- ,(if (< cut-width 0)
- `(,(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
+ 'length))
+ (substring-fun (if gnus-use-correct-string-widths
'gnus-correct-substring
- 'substring) ,el ,cut))
+ 'substring)))
+ (if (symbolp el)
+ `(if (> (,length-fun ,el) ,cut)
+ ,(if (< cut-width 0)
+ `(,substring-fun ,el 0 (- (,length-fun ,el) ,cut))
+ `(,substring-fun ,el ,cut))
,el)
`(let ((val (eval ,el)))
- (if (> (,(if gnus-use-correct-string-widths
- 'gnus-correct-length
- 'length) val) ,cut)
+ (if (> (,length-fun val) ,cut)
,(if (< cut-width 0)
- `(,(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))
+ `(,substring-fun val 0 (- (,length-fun val) ,cut))
+ `(,substring-fun val ,cut))
val)))))
(defun gnus-tilde-ignore-form (el ignore-value)
(if (equal val ,ignore-value)
"" val))))
+(defun gnus-correct-pad-form (el pad-width)
+ "Return a form that pads EL to PAD-WIDTH accounting for multi-column
+characters correctly. This is because `format' may pad to columns or to
+characters when given a pad value."
+ (let ((pad (abs pad-width))
+ (side (< 0 pad-width)))
+ (if (symbolp el)
+ `(let ((need (- ,pad (gnus-correct-length ,el))))
+ (if (> need 0)
+ (concat ,(when side '(make-string need ?\ ))
+ ,el
+ ,(when (not side) '(make-string need ?\ )))
+ ,el))
+ `(let* ((val (eval ,el))
+ (need (- ,pad (gnus-correct-length ,el))))
+ (if (> need 0)
+ (concat ,(when side '(make-string need ?\ ))
+ ,el
+ ,(when (not side) '(make-string need ?\ )))
+ ,el)))))
+
(defun gnus-parse-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 the
;; 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
+ (let ((case-fold-search nil))
+ (if (string-match
"\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'"
format)
(gnus-parse-complex-format format spec-alist)
- ;; This is a simple format.
- (gnus-parse-simple-format format spec-alist insert)))
+ ;; This is a simple format.
+ (gnus-parse-simple-format format spec-alist insert))))
(defun gnus-parse-complex-format (format spec-alist)
(save-excursion
(insert "\")")
;; Convert point position commands.
(goto-char (point-min))
- (while (re-search-forward "%\\([-0-9]+\\)?C" nil t)
- (replace-match "\"(point)\"" t t))
+ (let ((case-fold-search nil))
+ (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)
;; 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)
(let ((max-width 0)
spec flist fstring elem result dontinsert user-defined
type value pad-width spec-beg cut-width ignore-value
- tilde-form tilde elem-type)
+ tilde-form tilde elem-type extended-spec)
(save-excursion
(gnus-set-work-buffer)
(insert format)
max-width nil
cut-width nil
ignore-value nil
- tilde-form nil)
+ tilde-form nil
+ extended-spec nil)
(setq spec-beg (1- (point)))
;; Parse this spec fully.
t)
(t
nil)))
- ;; User-defined spec -- find the spec name.
- (when (eq (setq spec (char-after)) ?u)
+ (cond
+ ;; User-defined spec -- find the spec name.
+ ((eq (setq spec (char-after)) ?u)
(forward-char 1)
- (setq user-defined (char-after)))
+ (when (and (eq (setq user-defined (char-after)) ?&)
+ (looking-at "&\\([^;]+\\);"))
+ (setq user-defined (match-string 1))
+ (goto-char (match-end 1))))
+ ;; extended spec
+ ((and (eq spec ?&) (looking-at "&\\([^;]+\\);"))
+ (setq extended-spec (intern (match-string 1)))
+ (goto-char (match-end 1))))
(forward-char 1)
(delete-region spec-beg (point))
(user-defined
(setq elem
(list
- (list (intern (format "gnus-user-format-function-%c"
- user-defined))
+ (list (intern (format
+ (if (stringp user-defined)
+ "gnus-user-format-function-%s"
+ "gnus-user-format-function-%c")
+ user-defined))
'gnus-tmp-header)
?s)))
;; Find the specification from `spec-alist'.
- ((setq elem (cdr (assq spec spec-alist))))
+ ((setq elem (cdr (assq (or extended-spec spec) spec-alist))))
(t
(setq elem '("*" ?s))))
(setq elem-type (cadr elem))
;; Insert the new format elements.
- (when pad-width
+ (when (and pad-width
+ (not (and (featurep 'xemacs)
+ gnus-use-correct-string-widths)))
(insert (number-to-string pad-width)))
;; Create the form to be evaled.
- (if (or max-width cut-width ignore-value)
+ (if (or max-width cut-width ignore-value
+ (and (featurep 'xemacs)
+ gnus-use-correct-string-widths))
(progn
(insert ?s)
(let ((el (car elem)))
(setq el (gnus-tilde-cut-form el cut-width)))
(when max-width
(setq el (gnus-tilde-max-form el max-width)))
+ (when pad-width
+ (setq el (gnus-correct-pad-form el pad-width)))
(push el flist)))
(insert elem-type)
(push (car elem) flist))))
(setq
result
(cond
- ;; Emptyness.
+ ;; Emptiness.
((string= fstring "")
nil)
;; Not a format string.
(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)
projects / gnus / blobdiff