annotate lisp/gnus/format-spec.el @ 77104:3b47ef075a15

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