annotate lisp/format-spec.el @ 94780:80207eb81324

(png_load): Use correct bit-depth for setting background color.
author Chong Yidong <cyd@stupidchicken.com>
date Fri, 09 May 2008 02:37:31 +0000
parents ee5932bf781d
children a9dc0e7c3f2b
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
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
86923
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
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
13 ;; the Free Software Foundation, either version 3 of the License, or
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
14 ;; (at your option) any later version.
86923
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
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
86923
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
23
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
24 ;;; Commentary:
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 ;;; Code:
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 (eval-when-compile (require 'cl))
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 (defun format-spec (format specification)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
31 "Return a string based on FORMAT and SPECIFICATION.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
32 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
33 while SPECIFICATION is an alist mapping from format spec characters
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
34 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
35 the text that it generates."
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
36 (with-temp-buffer
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
37 (insert format)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
38 (goto-char (point-min))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
39 (while (search-forward "%" nil t)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
40 (cond
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
41 ;; Quoted percent sign.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
42 ((eq (char-after) ?%)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
43 (delete-char 1))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
44 ;; Valid format spec.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
45 ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)")
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
46 (let* ((num (match-string 1))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
47 (spec (string-to-char (match-string 2)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
48 (val (cdr (assq spec specification))))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
49 (unless val
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
50 (error "Invalid format character: `%%%c'" spec))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
51 ;; Pad result to desired length.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
52 (let ((text (format (concat "%" num "s") val)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
53 ;; Insert first, to preserve text properties.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
54 (insert-and-inherit text)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
55 ;; Delete the specifier body.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
56 (delete-region (+ (match-beginning 0) (length text))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
57 (+ (match-end 0) (length text)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
58 ;; Delete the percent sign.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
59 (delete-region (1- (match-beginning 0)) (match-beginning 0)))))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
60 ;; Signal an error on bogus format strings.
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
61 (t
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
62 (error "Invalid format string"))))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
63 (buffer-string)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
64
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
65 (defun format-spec-make (&rest pairs)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
66 "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
67 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
68 starting with a character."
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
69 (let (alist)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
70 (while pairs
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
71 (unless (cdr pairs)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
72 (error "Invalid list of pairs"))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
73 (push (cons (car pairs) (cadr pairs)) alist)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
74 (setq pairs (cddr pairs)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
75 (nreverse alist)))
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
76
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
77 (provide 'format-spec)
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
78
93975
1e3a407766b9 Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 87649
diff changeset
79 ;; arch-tag: c22d49cf-d167-445d-b7f1-2504d4173f53
86923
e69671140040 Move here from gnus/.
Glenn Morris <rgm@gnu.org>
parents:
diff changeset
80 ;;; format-spec.el ends here