(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)
+ (while (and (<= seek length)
(or (not end)
- (<= wend end)))
- (incf wend (gnus-char-width (aref string seek)))
+ (<= 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)
(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))))
projects / gnus / blobdiff