annotate lisp/format-spec.el @ 94627:9cc7bc51e055

(vc-rcs-fetch-master-state): Fix inf-loop.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Mon, 05 May 2008 06:38:04 +0000
parents 1e3a407766b9
children ee5932bf781d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
86923
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
1 ;;; format-spec.el --- functions for formatting arbitrary formatting strings
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
2
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
87649
107ccd98fa12 Merge from emacs--rel--22
Miles Bader <miles@gnu.org>
parents: 86923
diff changeset
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
86923
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
5
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
7 ;; Keywords: tools
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
8
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
10
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 3, or (at your option)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
14 ;; any later version.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
15
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
20
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
24 ;; Boston, MA 02110-1301, USA.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
25
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
26 ;;; Commentary:
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
27
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
28 ;;; Code:
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
29
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
30 (eval-when-compile (require 'cl))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
31
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
32 (defun format-spec (format specification)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
33 "Return a string based on FORMAT and SPECIFICATION.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
34 FORMAT is a string containing `format'-like specs like \"bash %u %k\",
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
35 while SPECIFICATION is an alist mapping from format spec characters
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
36 to values. Any text properties on a %-spec itself are propagated to
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
37 the text that it generates."
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
38 (with-temp-buffer
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
39 (insert format)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
40 (goto-char (point-min))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
41 (while (search-forward "%" nil t)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
42 (cond
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
43 ;; Quoted percent sign.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
44 ((eq (char-after) ?%)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
45 (delete-char 1))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
46 ;; Valid format spec.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
47 ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)")
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
48 (let* ((num (match-string 1))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
49 (spec (string-to-char (match-string 2)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
50 (val (cdr (assq spec specification))))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
51 (unless val
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
52 (error "Invalid format character: `%%%c'" spec))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
53 ;; Pad result to desired length.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
54 (let ((text (format (concat "%" num "s") val)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
55 ;; Insert first, to preserve text properties.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
56 (insert-and-inherit text)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
57 ;; Delete the specifier body.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
58 (delete-region (+ (match-beginning 0) (length text))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
59 (+ (match-end 0) (length text)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
60 ;; Delete the percent sign.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
61 (delete-region (1- (match-beginning 0)) (match-beginning 0)))))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
62 ;; Signal an error on bogus format strings.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
63 (t
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
64 (error "Invalid format string"))))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
65 (buffer-string)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
66
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
67 (defun format-spec-make (&rest pairs)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
68 "Return an alist suitable for use in `format-spec' based on PAIRS.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
69 PAIRS is a list where every other element is a character and a value,
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
70 starting with a character."
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
71 (let (alist)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
72 (while pairs
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
73 (unless (cdr pairs)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
74 (error "Invalid list of pairs"))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
75 (push (cons (car pairs) (cadr pairs)) alist)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
76 (setq pairs (cddr pairs)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
77 (nreverse alist)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
78
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
79 (provide 'format-spec)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
80
93975
1e3a407766b9 Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 87649
diff changeset
81 ;; arch-tag: c22d49cf-d167-445d-b7f1-2504d4173f53
86923
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
82 ;;; format-spec.el ends here