summaryrefslogtreecommitdiff
path: root/lisp/format-spec.el
blob: ee545d6d972342fb398b5a2128ca5a6bc93ec456 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
;;; format-spec.el --- functions for formatting arbitrary formatting strings

;; Copyright (C) 1999-2020 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: tools

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(eval-when-compile
  (require 'subr-x))

(defun format-spec (format specification &optional only-present)
  "Return a string based on FORMAT and SPECIFICATION.
FORMAT is a string containing `format'-like specs like \"su - %u %k\",
while SPECIFICATION is an alist mapping from format spec characters
to values.

For instance:

  (format-spec \"su - %u %l\"
               `((?u . ,(user-login-name))
                 (?l . \"ls\")))

Each format spec can have modifiers, where \"%<010b\" means \"if
the expansion is shorter than ten characters, zero-pad it, and if
it's longer, chop off characters from the left size\".

The following modifiers are allowed:

* 0: Use zero-padding.
* -: Pad to the right.
* ^: Upper-case the expansion.
* _: Lower-case the expansion.
* <: Limit the length by removing chars from the left.
* >: Limit the length by removing chars from the right.

Any text properties on a %-spec itself are propagated to the text
that it generates.

If ONLY-PRESENT, format spec characters not present in
SPECIFICATION are ignored, and the \"%\" characters are left
where they are, including \"%%\" strings."
  (with-temp-buffer
    (insert format)
    (goto-char (point-min))
    (while (search-forward "%" nil t)
      (cond
        ;; Quoted percent sign.
        ((eq (char-after) ?%)
         (unless only-present
	   (delete-char 1)))
        ;; Valid format spec.
        ((looking-at "\\([-0 _^<>]*\\)\\([0-9.]*\\)\\([a-zA-Z]\\)")
	 (let* ((modifiers (match-string 1))
                (num (match-string 2))
	        (spec (string-to-char (match-string 3)))
	        (val (assq spec specification)))
	   (if (not val)
               (unless only-present
	         (error "Invalid format character: `%%%c'" spec))
	     (setq val (cdr val)
                   modifiers (format-spec--parse-modifiers modifiers))
	     ;; Pad result to desired length.
	     (let ((text (format "%s" val)))
               (when num
                 (setq num (string-to-number num))
                 (setq text (format-spec--pad text num modifiers))
                 (when (> (length text) num)
                   (cond
                    ((memq :chop-left modifiers)
                     (setq text (substring text (- (length text) num))))
                    ((memq :chop-right modifiers)
                     (setq text (substring text 0 num))))))
               (when (memq :uppercase modifiers)
                 (setq text (upcase text)))
               (when (memq :lowercase modifiers)
                 (setq text (downcase text)))
	       ;; Insert first, to preserve text properties.
	       (insert-and-inherit text)
	       ;; Delete the specifier body.
               (delete-region (+ (match-beginning 0) (length text))
                              (+ (match-end 0) (length text)))
               ;; Delete the percent sign.
               (delete-region (1- (match-beginning 0)) (match-beginning 0))))))
        ;; Signal an error on bogus format strings.
        (t
          (unless only-present
	    (error "Invalid format string")))))
    (buffer-string)))

(defun format-spec--pad (text total-length modifiers)
  (if (> (length text) total-length)
      ;; The text is longer than the specified length; do nothing.
      text
    (let ((padding (make-string (- total-length (length text))
                                (if (memq :zero-pad modifiers)
                                    ?0
                                  ?\s))))
      (if (memq :right-pad modifiers)
          (concat text padding)
        (concat padding text)))))

(defun format-spec--parse-modifiers (modifiers)
  (mapcan (lambda (char)
            (when-let ((modifier
                        (pcase char
                          (?0 :zero-pad)
                          (?\s :space-pad)
                          (?^ :uppercase)
                          (?_ :lowercase)
                          (?- :right-pad)
                          (?< :chop-left)
                          (?> :chop-right))))
              (list modifier)))
          modifiers))

(defun format-spec-make (&rest pairs)
  "Return an alist suitable for use in `format-spec' based on PAIRS.
PAIRS is a list where every other element is a character and a value,
starting with a character."
  (let (alist)
    (while pairs
      (unless (cdr pairs)
	(error "Invalid list of pairs"))
      (push (cons (car pairs) (cadr pairs)) alist)
      (setq pairs (cddr pairs)))
    (nreverse alist)))

(provide 'format-spec)

;;; format-spec.el ends here