1 |
;;; gnus-spec.el --- format spec functions for Gnus -*- coding: iso-latin-1 -*- |
;;; gnus-spec.el --- format spec functions for Gnus |
2 |
;; Copyright (C) 1996, 1997, 1998, 1999, 2000 |
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 |
3 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
30 |
|
|
31 |
(require 'gnus) |
(require 'gnus) |
32 |
|
|
33 |
|
(defcustom gnus-use-correct-string-widths (featurep 'xemacs) |
34 |
|
"*If non-nil, use correct functions for dealing with wide characters." |
35 |
|
:group 'gnus-format |
36 |
|
:type 'boolean) |
37 |
|
|
38 |
|
(defcustom gnus-make-format-preserve-properties (featurep 'xemacs) |
39 |
|
"*If non-nil, use a replacement `format' function which preserves |
40 |
|
text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." |
41 |
|
:group 'gnus-format |
42 |
|
:type 'boolean) |
43 |
|
|
44 |
;;; Internal variables. |
;;; Internal variables. |
45 |
|
|
46 |
(defvar gnus-summary-mark-positions nil) |
(defvar gnus-summary-mark-positions nil) |
80 |
(defvar gnus-tmp-article-number) |
(defvar gnus-tmp-article-number) |
81 |
(defvar gnus-mouse-face) |
(defvar gnus-mouse-face) |
82 |
(defvar gnus-mouse-face-prop) |
(defvar gnus-mouse-face-prop) |
83 |
|
(defvar gnus-tmp-header) |
84 |
|
(defvar gnus-tmp-from) |
85 |
|
|
86 |
(defun gnus-summary-line-format-spec () |
(defun gnus-summary-line-format-spec () |
87 |
(insert gnus-tmp-unread gnus-tmp-replied |
(insert gnus-tmp-unread gnus-tmp-replied |
90 |
(point) |
(point) |
91 |
(progn |
(progn |
92 |
(insert |
(insert |
93 |
gnus-tmp-opening-bracket |
(format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines |
94 |
(format "%4d: %-20s" |
(let ((val |
95 |
gnus-tmp-lines |
(inline |
96 |
(if (> (length gnus-tmp-name) 20) |
(gnus-summary-from-or-to-or-newsgroups |
97 |
(substring gnus-tmp-name 0 20) |
gnus-tmp-header gnus-tmp-from)))) |
98 |
gnus-tmp-name)) |
(if (> (length val) 23) |
99 |
gnus-tmp-closing-bracket) |
(substring val 0 23) |
100 |
|
val)) |
101 |
|
gnus-tmp-closing-bracket)) |
102 |
(point)) |
(point)) |
103 |
gnus-mouse-face-prop gnus-mouse-face) |
gnus-mouse-face-prop gnus-mouse-face) |
104 |
(insert " " gnus-tmp-subject-or-nil "\n")) |
(insert " " gnus-tmp-subject-or-nil "\n")) |
135 |
|
|
136 |
(defvar gnus-format-specs |
(defvar gnus-format-specs |
137 |
`((version . ,emacs-version) |
`((version . ,emacs-version) |
138 |
|
(gnus-version . ,(gnus-continuum-version)) |
139 |
(group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) |
(group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) |
140 |
(summary-dummy "* %(: :%) %S\n" |
(summary-dummy "* %(: :%) %S\n" |
141 |
,gnus-summary-dummy-line-format-spec) |
,gnus-summary-dummy-line-format-spec) |
142 |
(summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" |
(summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" |
143 |
,gnus-summary-line-format-spec)) |
,gnus-summary-line-format-spec)) |
144 |
"Alist of format specs.") |
"Alist of format specs.") |
145 |
|
|
146 |
|
(defvar gnus-default-format-specs gnus-format-specs) |
147 |
|
|
148 |
(defvar gnus-article-mode-line-format-spec nil) |
(defvar gnus-article-mode-line-format-spec nil) |
149 |
(defvar gnus-summary-mode-line-format-spec nil) |
(defvar gnus-summary-mode-line-format-spec nil) |
150 |
(defvar gnus-group-mode-line-format-spec nil) |
(defvar gnus-group-mode-line-format-spec nil) |
151 |
|
|
152 |
;;; Phew. All that gruft is over, fortunately. |
;;; Phew. All that gruft is over with, fortunately. |
153 |
|
|
154 |
;;;###autoload |
;;;###autoload |
155 |
(defun gnus-update-format (var) |
(defun gnus-update-format (var) |
180 |
(pop-to-buffer "*Gnus Format*") |
(pop-to-buffer "*Gnus Format*") |
181 |
(erase-buffer) |
(erase-buffer) |
182 |
(lisp-interaction-mode) |
(lisp-interaction-mode) |
183 |
(insert (pp-to-string spec)))) |
(insert (gnus-pp-to-string spec)))) |
184 |
|
|
185 |
(defun gnus-update-format-specifications (&optional force &rest types) |
(defun gnus-update-format-specifications (&optional force &rest types) |
186 |
"Update all (necessary) format specifications." |
"Update all (necessary) format specifications." |
187 |
;; Make the indentation array. |
;; Make the indentation array. |
188 |
;; See whether all the stored info needs to be flushed. |
;; See whether all the stored info needs to be flushed. |
189 |
(when (or force |
(when (or force |
190 |
|
(not gnus-newsrc-file-version) |
191 |
|
(not (equal (gnus-continuum-version) |
192 |
|
(gnus-continuum-version gnus-newsrc-file-version))) |
193 |
(not (equal emacs-version |
(not (equal emacs-version |
194 |
(cdr (assq 'version gnus-format-specs))))) |
(cdr (assq 'version gnus-format-specs))))) |
195 |
(setq gnus-format-specs nil)) |
(setq gnus-format-specs nil)) |
197 |
;; Go through all the formats and see whether they need updating. |
;; Go through all the formats and see whether they need updating. |
198 |
(let (new-format entry type val) |
(let (new-format entry type val) |
199 |
(while (setq type (pop types)) |
(while (setq type (pop types)) |
200 |
;; Jump to the proper buffer to find out the value of |
;; Jump to the proper buffer to find out the value of the |
201 |
;; the variable, if possible. (It may be buffer-local.) |
;; variable, if possible. (It may be buffer-local.) |
202 |
(save-excursion |
(save-excursion |
203 |
(let ((buffer (intern (format "gnus-%s-buffer" type))) |
(let ((buffer (intern (format "gnus-%s-buffer" type))) |
204 |
val) |
val) |
264 |
(defun gnus-balloon-face-function (form type) |
(defun gnus-balloon-face-function (form type) |
265 |
`(gnus-put-text-property |
`(gnus-put-text-property |
266 |
(point) (progn ,@form (point)) |
(point) (progn ,@form (point)) |
267 |
'balloon-help |
,(if (fboundp 'balloon-help-mode) |
268 |
|
''balloon-help |
269 |
|
''help-echo) |
270 |
,(intern (format "gnus-balloon-face-%d" type)))) |
,(intern (format "gnus-balloon-face-%d" type)))) |
271 |
|
|
272 |
|
(defun gnus-spec-tab (column) |
273 |
|
(if (> column 0) |
274 |
|
`(insert (make-string (max (- ,column (current-column)) 0) ? )) |
275 |
|
(let ((column (abs column))) |
276 |
|
(if gnus-use-correct-string-widths |
277 |
|
`(progn |
278 |
|
(if (> (current-column) ,column) |
279 |
|
(while (progn |
280 |
|
(delete-backward-char 1) |
281 |
|
(> (current-column) ,column)))) |
282 |
|
(insert (make-string (max (- ,column (current-column)) 0) ? ))) |
283 |
|
`(progn |
284 |
|
(if (> (current-column) ,column) |
285 |
|
(delete-region (point) |
286 |
|
(- (point) (- (current-column) ,column))) |
287 |
|
(insert (make-string (max (- ,column (current-column)) 0) |
288 |
|
? )))))))) |
289 |
|
|
290 |
|
(defun gnus-correct-length (string) |
291 |
|
"Return the correct width of STRING." |
292 |
|
(let ((length 0)) |
293 |
|
(mapcar (lambda (char) (incf length (gnus-char-width char))) string) |
294 |
|
length)) |
295 |
|
|
296 |
|
(defun gnus-correct-substring (string start &optional end) |
297 |
|
(let ((wstart 0) |
298 |
|
(wend 0) |
299 |
|
(wseek 0) |
300 |
|
(seek 0) |
301 |
|
(length (length string)) |
302 |
|
(string (concat string "\0"))) |
303 |
|
;; Find the start position. |
304 |
|
(while (and (< seek length) |
305 |
|
(< wseek start)) |
306 |
|
(incf wseek (gnus-char-width (aref string seek))) |
307 |
|
(incf seek)) |
308 |
|
(setq wstart seek) |
309 |
|
;; Find the end position. |
310 |
|
(while (and (<= seek length) |
311 |
|
(or (not end) |
312 |
|
(<= wseek end))) |
313 |
|
(incf wseek (gnus-char-width (aref string seek))) |
314 |
|
(incf seek)) |
315 |
|
(setq wend seek) |
316 |
|
(substring string wstart (1- wend)))) |
317 |
|
|
318 |
|
(defun gnus-string-width-function () |
319 |
|
(cond |
320 |
|
(gnus-use-correct-string-widths |
321 |
|
'gnus-correct-length) |
322 |
|
((fboundp 'string-width) |
323 |
|
'string-width) |
324 |
|
(t |
325 |
|
'length))) |
326 |
|
|
327 |
|
(defun gnus-substring-function () |
328 |
|
(cond |
329 |
|
(gnus-use-correct-string-widths |
330 |
|
'gnus-correct-substring) |
331 |
|
((fboundp 'string-width) |
332 |
|
'gnus-correct-substring) |
333 |
|
(t |
334 |
|
'substring))) |
335 |
|
|
336 |
(defun gnus-tilde-max-form (el max-width) |
(defun gnus-tilde-max-form (el max-width) |
337 |
"Return a form that limits EL to MAX-WIDTH." |
"Return a form that limits EL to MAX-WIDTH." |
338 |
(let ((max (abs max-width))) |
(let ((max (abs max-width)) |
339 |
|
(length-fun (gnus-string-width-function)) |
340 |
|
(substring-fun (gnus-substring-function))) |
341 |
(if (symbolp el) |
(if (symbolp el) |
342 |
`(if (> (length ,el) ,max) |
`(if (> (,length-fun ,el) ,max) |
343 |
,(if (< max-width 0) |
,(if (< max-width 0) |
344 |
`(substring ,el (- (length el) ,max)) |
`(,substring-fun ,el (- (,length-fun ,el) ,max)) |
345 |
`(substring ,el 0 ,max)) |
`(,substring-fun ,el 0 ,max)) |
346 |
,el) |
,el) |
347 |
`(let ((val (eval ,el))) |
`(let ((val (eval ,el))) |
348 |
(if (> (length val) ,max) |
(if (> (,length-fun val) ,max) |
349 |
,(if (< max-width 0) |
,(if (< max-width 0) |
350 |
`(substring val (- (length val) ,max)) |
`(,substring-fun val (- (,length-fun val) ,max)) |
351 |
`(substring val 0 ,max)) |
`(,substring-fun val 0 ,max)) |
352 |
val))))) |
val))))) |
353 |
|
|
354 |
(defun gnus-tilde-cut-form (el cut-width) |
(defun gnus-tilde-cut-form (el cut-width) |
355 |
"Return a form that cuts CUT-WIDTH off of EL." |
"Return a form that cuts CUT-WIDTH off of EL." |
356 |
(let ((cut (abs cut-width))) |
(let ((cut (abs cut-width)) |
357 |
|
(length-fun (gnus-string-width-function)) |
358 |
|
(substring-fun (gnus-substring-function))) |
359 |
(if (symbolp el) |
(if (symbolp el) |
360 |
`(if (> (length ,el) ,cut) |
`(if (> (,length-fun ,el) ,cut) |
361 |
,(if (< cut-width 0) |
,(if (< cut-width 0) |
362 |
`(substring ,el 0 (- (length el) ,cut)) |
`(,substring-fun ,el 0 (- (,length-fun ,el) ,cut)) |
363 |
`(substring ,el ,cut)) |
`(,substring-fun ,el ,cut)) |
364 |
,el) |
,el) |
365 |
`(let ((val (eval ,el))) |
`(let ((val (eval ,el))) |
366 |
(if (> (length val) ,cut) |
(if (> (,length-fun val) ,cut) |
367 |
,(if (< cut-width 0) |
,(if (< cut-width 0) |
368 |
`(substring val 0 (- (length val) ,cut)) |
`(,substring-fun val 0 (- (,length-fun val) ,cut)) |
369 |
`(substring val ,cut)) |
`(,substring-fun val ,cut)) |
370 |
val))))) |
val))))) |
371 |
|
|
372 |
(defun gnus-tilde-ignore-form (el ignore-value) |
(defun gnus-tilde-ignore-form (el ignore-value) |
378 |
(if (equal val ,ignore-value) |
(if (equal val ,ignore-value) |
379 |
"" val)))) |
"" val)))) |
380 |
|
|
381 |
|
(defun gnus-pad-form (el pad-width) |
382 |
|
"Return a form that pads EL to PAD-WIDTH accounting for multi-column |
383 |
|
characters correctly. This is because `format' may pad to columns or to |
384 |
|
characters when given a pad value." |
385 |
|
(let ((pad (abs pad-width)) |
386 |
|
(side (< 0 pad-width)) |
387 |
|
(length-fun (gnus-string-width-function))) |
388 |
|
(if (symbolp el) |
389 |
|
`(let ((need (- ,pad (,length-fun ,el)))) |
390 |
|
(if (> need 0) |
391 |
|
(concat ,(when side '(make-string need ?\ )) |
392 |
|
,el |
393 |
|
,(when (not side) '(make-string need ?\ ))) |
394 |
|
,el)) |
395 |
|
`(let* ((val (eval ,el)) |
396 |
|
(need (- ,pad (,length-fun val)))) |
397 |
|
(if (> need 0) |
398 |
|
(concat ,(when side '(make-string need ?\ )) |
399 |
|
val |
400 |
|
,(when (not side) '(make-string need ?\ ))) |
401 |
|
val))))) |
402 |
|
|
403 |
(defun gnus-parse-format (format spec-alist &optional insert) |
(defun gnus-parse-format (format spec-alist &optional insert) |
404 |
;; This function parses the FORMAT string with the help of the |
;; This function parses the FORMAT string with the help of the |
405 |
;; SPEC-ALIST and returns a list that can be eval'ed to return the |
;; SPEC-ALIST and returns a list that can be eval'ed to return the |
407 |
;; the text between them will have the mouse-face text property. |
;; the text between them will have the mouse-face text property. |
408 |
;; If the FORMAT string contains the specifiers %[ and %], the text between |
;; If the FORMAT string contains the specifiers %[ and %], the text between |
409 |
;; them will have the balloon-help text property. |
;; them will have the balloon-help text property. |
410 |
(if (string-match |
(let ((case-fold-search nil)) |
411 |
"\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'" |
(if (string-match |
412 |
format) |
"\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*\\*" |
413 |
(gnus-parse-complex-format format spec-alist) |
format) |
414 |
;; This is a simple format. |
(gnus-parse-complex-format format spec-alist) |
415 |
(gnus-parse-simple-format format spec-alist insert))) |
;; This is a simple format. |
416 |
|
(gnus-parse-simple-format format spec-alist insert)))) |
417 |
|
|
418 |
(defun gnus-parse-complex-format (format spec-alist) |
(defun gnus-parse-complex-format (format spec-alist) |
419 |
(save-excursion |
(let ((cursor-spec nil)) |
420 |
(gnus-set-work-buffer) |
(save-excursion |
421 |
(insert format) |
(gnus-set-work-buffer) |
422 |
(goto-char (point-min)) |
(insert format) |
423 |
(while (re-search-forward "\"" nil t) |
(goto-char (point-min)) |
424 |
(replace-match "\\\"" nil t)) |
(while (re-search-forward "\"" nil t) |
425 |
(goto-char (point-min)) |
(replace-match "\\\"" nil t)) |
426 |
(insert "(\"") |
(goto-char (point-min)) |
427 |
(while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t) |
(insert "(\"") |
428 |
(let ((number (if (match-beginning 1) |
;; Convert all font specs into font spec lists. |
429 |
(match-string 1) "0")) |
(while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t) |
430 |
(delim (aref (match-string 2) 0))) |
(let ((number (if (match-beginning 1) |
431 |
(if (or (= delim ?\() |
(match-string 1) "0")) |
432 |
(= delim ?\{) |
(delim (aref (match-string 2) 0))) |
433 |
(= delim ?\«)) |
(if (or (= delim ?\() |
434 |
(replace-match (concat "\"(" |
(= delim ?\{) |
435 |
(cond ((= delim ?\() "mouse") |
(= delim ?\«)) |
436 |
((= delim ?\{) "face") |
(replace-match (concat "\"(" |
437 |
(t "balloon")) |
(cond ((= delim ?\() "mouse") |
438 |
" " number " \"")) |
((= delim ?\{) "face") |
439 |
(replace-match "\")\"")))) |
(t "balloon")) |
440 |
(goto-char (point-max)) |
" " number " \"") |
441 |
(insert "\")") |
t t) |
442 |
(goto-char (point-min)) |
(replace-match "\")\"")))) |
443 |
(let ((form (read (current-buffer)))) |
(goto-char (point-max)) |
444 |
(cons 'progn (gnus-complex-form-to-spec form spec-alist))))) |
(insert "\")") |
445 |
|
;; Convert point position commands. |
446 |
|
(goto-char (point-min)) |
447 |
|
(let ((case-fold-search nil)) |
448 |
|
(while (re-search-forward "%\\([-0-9]+\\)?\\*" nil t) |
449 |
|
(replace-match "\"(point)\"" t t) |
450 |
|
(setq cursor-spec t))) |
451 |
|
;; Convert TAB commands. |
452 |
|
(goto-char (point-min)) |
453 |
|
(while (re-search-forward "%\\([-0-9]+\\)=" nil t) |
454 |
|
(replace-match (format "\"(tab %s)\"" (match-string 1)) t t)) |
455 |
|
;; Convert the buffer into the spec. |
456 |
|
(goto-char (point-min)) |
457 |
|
(let ((form (read (current-buffer)))) |
458 |
|
(if cursor-spec |
459 |
|
`(let (gnus-position) |
460 |
|
,@(gnus-complex-form-to-spec form spec-alist) |
461 |
|
(if gnus-position |
462 |
|
(gnus-put-text-property gnus-position (1+ gnus-position) |
463 |
|
'gnus-position t))) |
464 |
|
`(progn |
465 |
|
,@(gnus-complex-form-to-spec form spec-alist))))))) |
466 |
|
|
467 |
(defun gnus-complex-form-to-spec (form spec-alist) |
(defun gnus-complex-form-to-spec (form spec-alist) |
468 |
(delq nil |
(delq nil |
469 |
(mapcar |
(mapcar |
470 |
(lambda (sform) |
(lambda (sform) |
471 |
(if (stringp sform) |
(cond |
472 |
(gnus-parse-simple-format sform spec-alist t) |
((stringp sform) |
473 |
|
(gnus-parse-simple-format sform spec-alist t)) |
474 |
|
((eq (car sform) 'point) |
475 |
|
'(setq gnus-position (point))) |
476 |
|
((eq (car sform) 'tab) |
477 |
|
(gnus-spec-tab (cadr sform))) |
478 |
|
(t |
479 |
(funcall (intern (format "gnus-%s-face-function" (car sform))) |
(funcall (intern (format "gnus-%s-face-function" (car sform))) |
480 |
(gnus-complex-form-to-spec (cddr sform) spec-alist) |
(gnus-complex-form-to-spec (cddr sform) spec-alist) |
481 |
(nth 1 sform)))) |
(nth 1 sform))))) |
482 |
form))) |
form))) |
483 |
|
|
484 |
|
|
485 |
|
(defun gnus-xmas-format (fstring &rest args) |
486 |
|
"A version of `format' which preserves text properties. |
487 |
|
|
488 |
|
Required for XEmacs, where the built in `format' function strips all text |
489 |
|
properties from both the format string and any inserted strings. |
490 |
|
|
491 |
|
Only supports the format sequence %s, and %% for inserting |
492 |
|
literal % characters. A pad width and an optional - (to right pad) |
493 |
|
are supported for %s." |
494 |
|
(let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s") |
495 |
|
(n (length args))) |
496 |
|
(with-temp-buffer |
497 |
|
(insert fstring) |
498 |
|
(goto-char (point-min)) |
499 |
|
(while (re-search-forward re nil t) |
500 |
|
(goto-char (match-end 0)) |
501 |
|
(cond |
502 |
|
((string= (match-string 0) "%%") |
503 |
|
(delete-char -1)) |
504 |
|
(t |
505 |
|
(if (null args) |
506 |
|
(error 'wrong-number-of-arguments #'my-format n fstring)) |
507 |
|
(let* ((minlen (string-to-int (or (match-string 2) ""))) |
508 |
|
(arg (car args)) |
509 |
|
(str (if (stringp arg) arg (format "%s" arg))) |
510 |
|
(lpad (null (match-string 1))) |
511 |
|
(padlen (max 0 (- minlen (length str))))) |
512 |
|
(replace-match "") |
513 |
|
(if lpad (insert-char ?\ padlen)) |
514 |
|
(insert str) |
515 |
|
(unless lpad (insert-char ?\ padlen)) |
516 |
|
(setq args (cdr args)))))) |
517 |
|
(buffer-string)))) |
518 |
|
|
519 |
(defun gnus-parse-simple-format (format spec-alist &optional insert) |
(defun gnus-parse-simple-format (format spec-alist &optional insert) |
520 |
;; This function parses the FORMAT string with the help of the |
;; This function parses the FORMAT string with the help of the |
521 |
;; SPEC-ALIST and returns a list that can be eval'ed to return a |
;; SPEC-ALIST and returns a list that can be eval'ed to return a |
523 |
(let ((max-width 0) |
(let ((max-width 0) |
524 |
spec flist fstring elem result dontinsert user-defined |
spec flist fstring elem result dontinsert user-defined |
525 |
type value pad-width spec-beg cut-width ignore-value |
type value pad-width spec-beg cut-width ignore-value |
526 |
tilde-form tilde elem-type) |
tilde-form tilde elem-type extended-spec) |
527 |
(save-excursion |
(save-excursion |
528 |
(gnus-set-work-buffer) |
(gnus-set-work-buffer) |
529 |
(insert format) |
(insert format) |
535 |
max-width nil |
max-width nil |
536 |
cut-width nil |
cut-width nil |
537 |
ignore-value nil |
ignore-value nil |
538 |
tilde-form nil) |
tilde-form nil |
539 |
|
extended-spec nil) |
540 |
(setq spec-beg (1- (point))) |
(setq spec-beg (1- (point))) |
541 |
|
|
542 |
;; Parse this spec fully. |
;; Parse this spec fully. |
577 |
t) |
t) |
578 |
(t |
(t |
579 |
nil))) |
nil))) |
580 |
;; User-defined spec -- find the spec name. |
(cond |
581 |
(when (eq (setq spec (char-after)) ?u) |
;; User-defined spec -- find the spec name. |
582 |
|
((eq (setq spec (char-after)) ?u) |
583 |
(forward-char 1) |
(forward-char 1) |
584 |
(setq user-defined (char-after))) |
(when (and (eq (setq user-defined (char-after)) ?&) |
585 |
|
(looking-at "&\\([^;]+\\);")) |
586 |
|
(setq user-defined (match-string 1)) |
587 |
|
(goto-char (match-end 1)))) |
588 |
|
;; extended spec |
589 |
|
((and (eq spec ?&) (looking-at "&\\([^;]+\\);")) |
590 |
|
(setq extended-spec (intern (match-string 1))) |
591 |
|
(goto-char (match-end 1)))) |
592 |
(forward-char 1) |
(forward-char 1) |
593 |
(delete-region spec-beg (point)) |
(delete-region spec-beg (point)) |
594 |
|
|
606 |
(user-defined |
(user-defined |
607 |
(setq elem |
(setq elem |
608 |
(list |
(list |
609 |
(list (intern (format "gnus-user-format-function-%c" |
(list (intern (format |
610 |
user-defined)) |
(if (stringp user-defined) |
611 |
|
"gnus-user-format-function-%s" |
612 |
|
"gnus-user-format-function-%c") |
613 |
|
user-defined)) |
614 |
'gnus-tmp-header) |
'gnus-tmp-header) |
615 |
?s))) |
?s))) |
616 |
;; Find the specification from `spec-alist'. |
;; Find the specification from `spec-alist'. |
617 |
((setq elem (cdr (assq spec spec-alist)))) |
((setq elem (cdr (assq (or extended-spec spec) spec-alist)))) |
618 |
(t |
(t |
619 |
(setq elem '("*" ?s)))) |
(setq elem '("*" ?s)))) |
620 |
(setq elem-type (cadr elem)) |
(setq elem-type (cadr elem)) |
621 |
;; Insert the new format elements. |
;; Insert the new format elements. |
622 |
(when pad-width |
(when (and pad-width |
623 |
|
(not (and (featurep 'xemacs) |
624 |
|
gnus-use-correct-string-widths))) |
625 |
(insert (number-to-string pad-width))) |
(insert (number-to-string pad-width))) |
626 |
;; Create the form to be evaled. |
;; Create the form to be evaled. |
627 |
(if (or max-width cut-width ignore-value) |
(if (or max-width cut-width ignore-value |
628 |
|
(and (featurep 'xemacs) |
629 |
|
gnus-use-correct-string-widths)) |
630 |
(progn |
(progn |
631 |
(insert ?s) |
(insert ?s) |
632 |
(let ((el (car elem))) |
(let ((el (car elem))) |
640 |
(setq el (gnus-tilde-cut-form el cut-width))) |
(setq el (gnus-tilde-cut-form el cut-width))) |
641 |
(when max-width |
(when max-width |
642 |
(setq el (gnus-tilde-max-form el max-width))) |
(setq el (gnus-tilde-max-form el max-width))) |
643 |
|
(when pad-width |
644 |
|
(setq el (gnus-pad-form el pad-width))) |
645 |
(push el flist))) |
(push el flist))) |
646 |
(insert elem-type) |
(insert elem-type) |
647 |
(push (car elem) flist)))) |
(push (car elem) flist)))) |
648 |
(setq fstring (buffer-string))) |
(setq fstring (buffer-substring-no-properties (point-min) (point-max)))) |
649 |
|
|
650 |
;; Do some postprocessing to increase efficiency. |
;; Do some postprocessing to increase efficiency. |
651 |
(setq |
(setq |
652 |
result |
result |
653 |
(cond |
(cond |
654 |
;; Emptyness. |
;; Emptiness. |
655 |
((string= fstring "") |
((string= fstring "") |
656 |
nil) |
nil) |
657 |
;; Not a format string. |
;; Not a format string. |
681 |
;; A single string spec in the end of the spec. |
;; A single string spec in the end of the spec. |
682 |
((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) |
((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) |
683 |
(list (match-string 1 fstring) (car flist))) |
(list (match-string 1 fstring) (car flist))) |
684 |
|
;; Only string (and %) specs (XEmacs only!) |
685 |
|
((and (featurep 'xemacs) |
686 |
|
gnus-make-format-preserve-properties |
687 |
|
(string-match |
688 |
|
"\\`\\([^%]*\\(%%\\|%-?\\([1-9][0-9]*\\)?s\\)\\)*[^%]*\\'" |
689 |
|
fstring)) |
690 |
|
(list (cons 'gnus-xmas-format (cons fstring (nreverse flist))))) |
691 |
;; A more complex spec. |
;; A more complex spec. |
692 |
(t |
(t |
693 |
(list (cons 'format (cons fstring (nreverse flist))))))) |
(list (cons 'format (cons fstring (nreverse flist))))))) |
723 |
|
|
724 |
(while entries |
(while entries |
725 |
(setq entry (pop entries)) |
(setq entry (pop entries)) |
726 |
(if (eq (car entry) 'version) |
(if (memq (car entry) '(gnus-version version)) |
727 |
(setq gnus-format-specs (delq entry gnus-format-specs)) |
(setq gnus-format-specs (delq entry gnus-format-specs)) |
728 |
(let ((form (caddr entry))) |
(let ((form (caddr entry))) |
729 |
(when (and (listp form) |
(when (and (listp form) |
732 |
;; Under XEmacs, it's (funcall #<compiled-function ...>) |
;; Under XEmacs, it's (funcall #<compiled-function ...>) |
733 |
(not (and (eq 'funcall (car form)) |
(not (and (eq 'funcall (car form)) |
734 |
(byte-code-function-p (cadr form))))) |
(byte-code-function-p (cadr form))))) |
735 |
(fset 'gnus-tmp-func `(lambda () ,form)) |
(defalias 'gnus-tmp-func `(lambda () ,form)) |
736 |
(byte-compile 'gnus-tmp-func) |
(byte-compile 'gnus-tmp-func) |
737 |
(setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))) |
(setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))) |
738 |
|
|