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 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390
|
;;; Sformat --- souped up format
;;
;; Author: Eric Ludlam (zappo@gnu.org)
;; Version: 1.4
;; Keywords: extensions
;;
;; Copyright (C) 1994, 1996, 1998, 1999, 2000 Free Software Foundation
;;
;; This program 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 2, or (at your option)
;; any later version.
;;
;; This program 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 this program; if not, you can either send email to this
;; program's author (see below) or write to:
;;
;; The Free Software Foundation, Inc.
;; 675 Mass Ave.
;; Cambridge, MA 02139, USA.
;;
;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
;;
;;; Commentary:
;;
;; In some applications configuration strings have % options in them
;; which permit special strings to be inserted. There are many other
;; programs which would also benefit from such configuration, but do
;; not have it due to the time required to build such an extension.
;; Sformat fills that need making the creation of such functions
;; quite simple.
;;; v 1.3
;; * If no args are passed, then don't attempt to post-format the string.
;; * Format reversing functions `sformat-just-before-token-regexp' and
;; `sformat-just-after-token-regexp'
;;; v 1.2
;; Sformat has been sped up by using string commands (string-match,
;; and substring) to quickly scan over plain text, and then a slower
;; character by character scan to handle tokens.
;;; $Id: sformat.el,v 1.3 2000/05/06 01:34:32 zappo Exp $
;;
;; History
;;
;; eml: 1998/09/11
;; XEmacs no longer treats a ?c character as an integer. Change this
;; check to look at it as a char-or-string.
;; eml 8/17/94
;; Added positional data, and ability to handle lambda functions in
;; options list for more general use.
;; eml 5/3/95
;; Added speed up mentioned above
;; eml 9/8/96
;; Fixed error where if sizing number = string length, nothing came out
;; Added ability to pad a string w/ 0s. Don't use w/ neg argument. ;)
;; Added speedup to a list searches
;;; Code:
(defvar Sformat-default-format 'Sformat-default-format-method
"Function used when the input param is a string and not a function.
This function must conform to the following parameters:
1 - string to be formatted
2 - A1
3 - A2
4 - A1 default or fn
5 - A2 default or fn")
(defvar Sformat-formatting nil
"This flags when Sformat is currently formatting a string.")
(defun Sformat-point ()
"Return the current offset in the string being formated.
Called from % token lambda expressions when needed."
(length newstr))
(defun Sformat-column ()
"Return the current column inside a string being formatted.
Used from % token lambda expressions."
(let ((ts newstr))
(while (string-match "\\(\n\\)" ts)
(setq ts (substring ts (match-end 1))))
(length ts)))
(defun Sformat (extensions fmt &rest args)
"Provide a simple means of formatting strings with special % options.
This will use EXTENSIONS to fill out FMT, and then pass the
result to #<subr format> with ARGS. EXTENSIONS is of the form:
'( (?F local-filename A1default A2default)
(?U local-username) )
where F is the character after a %, and 'local-filename is a variable
or function. If it is a function, it must be able to take 2 numeric
arguments. The args can be used for whatever purpose you desire for
the function. A string or variable holding a string will have it's
value inserted just as `Sformat-string-word-format' would cut it up.
This action can be modified by changing what the variable
`Sformat-default-format' points to. A1default and A2default can be
either default values for A1 or A2, or symbols to be used when cutting
this specific string into little pieces. Numbers are formatted as per
%d with A#defaults being used (numeric only). Lambda functions passed
in directly as lists will be evaled with no parameters. Anything else
will be inserted as %S would with A#defaults being used (numeric
only).
Viable formats would be:
%-10v - 10 chars, pad left
%.1v %:1v - first word
%10.2v %10:2v - 10 chars, pad right for first 2 words
%03v - at least 3 chars, padded w/ zeros at beginning
where v is some format character. Note that . and : are interchangeable
(Sformat extensions fmt &rest args)"
;; verify arguments
(if (not (listp extensions))
(signal 'wrong-type-argument (list 'listp extensions)))
(if (not (stringp fmt))
(signal 'wrong-type-argument (list 'stringp fmt)))
(let ((Sformat-formatting t) ;Yes, we are formatting something
(cnt 0) ;position in string
(tl nil) ;temp list of extensions
(ln (length fmt)) ;length of fmt string
(tc nil) ;temp char
(newstr "") ;the new string
(pcnt nil) ;% symbol flag
(dot nil) ;. symbol flag
(neg1 nil) ;- symbol flag on arg1
(neg2 nil) ;- symbol flag on arg2
(zpad nil) ;numeric starts /w 0
(A1 nil) ;arg 1
(A2 nil)) ;arg 2
(while (/= (length fmt) 0)
(if (string-match "\\(%\\)" fmt)
(progn
(setq newstr (concat newstr (substring fmt 0 (match-beginning 1))))
(setq fmt (substring fmt (match-end 1)))
(setq pcnt t))
(setq newstr (concat newstr fmt))
(setq fmt ""))
(setq cnt 0)
(while pcnt
(setq tc (aref fmt cnt))
(if (not pcnt)
(if (= tc ?%)
(setq pcnt t)
(setq newstr (concat newstr (char-to-string tc))))
(cond
((or (= tc ?.) (= tc ?:)) ;. such as %1.2F
(if dot
(error "Too many . or : in %% formatter!")
(setq dot t)))
((= tc ?-) ;- such as %-1F
(if dot
(if A2 (error "Cannot use '-' in middle of numeric arg")
(setq neg2 t))
(if A1 (error "Cannot use '-' in middle of numeric arg")
(setq neg1 t))))
((and (<= tc ?9) (>= tc ?0)) ;number arg
(if dot
(progn
(if (not A2) (setq A2 0))
(setq A2 (+ (* A2 10) (- tc ?0))))
(if (not A1) (progn
;; check for 0 padding
(if (= tc ?0) (setq zpad t))
(setq A1 0)))
(setq A1 (+ (* A1 10) (- tc ?0)))))
(t ;the F in %F
(setq tl (assoc tc extensions))
;; negafy A1 and A2 if need be.
(if (and neg1 A1) (setq A1 (- A1)))
(if (and neg2 A2) (setq A2 (- A2)))
;; if we don't find it, pass through verbatim
(if (not tl)
(let ((tmpstr (concat "%"
(if A1 (format "%d" A1))
(if A2 (format ".%d" A2))
(char-to-string tc))))
(setq newstr (concat newstr tmpstr)))
(if (not (char-or-string-p (car tl)))
(error "Invalid extensions list passed to Sformat"))
(if (and (not A1) (numberp (car (cdr (cdr tl)))))
(setq A1 (car (cdr (cdr tl)))))
(if (and (not A2) (numberp (car (cdr (cdr (cdr tl))))))
(setq A2 (car (cdr (cdr (cdr tl))))))
(let* ((v (car (cdr tl)))
(sym (if (symbolp v) (eval v) v))
(tmpstr (cond
((and (symbolp sym) (fboundp sym))
(funcall sym A1 A2))
((and (listp sym) (equal (car sym) 'lambda))
(funcall sym))
((stringp sym)
(let ((m1 (car (cdr (cdr tl)))))
(if zpad
(if m1 (setq m1 (intern
(symbol-name m1)
"-0"))
(setq m1 'both-0)))
(funcall Sformat-default-format
sym A1 A2 m1
(car (cdr (cdr (cdr tl)))))))
((numberp sym)
(setq zpad (if zpad "0" ""))
(format (concat "%"
(if A1 (format
(concat zpad"%d")
A1))
(if A2 (format ".%d" A2))
"d")
sym))
(t
(format (concat "%"
(if A1 (format "%d" A1))
(if A2 (format ".%d" A2))
"S")
sym)))))
(setq newstr (concat newstr tmpstr))))
(setq A1 nil A2 nil neg1 nil neg2 nil zpad nil dot nil pcnt nil)
)
)
)
(setq cnt (1+ cnt))
)
(setq fmt (substring fmt cnt))
)
(if args (funcall 'format newstr args) newstr)
))
(defun Sformat-default-format-method (str A1 A2 A1def A2def)
"Format routine used when the format method is a string.
STR is the text to be formated. A1 and A2 represent the passed in
format adjustors. (Of the form %A1.A2C) where C is a code, and A1
and A2 are numbers. A1DEF and A2DEF are default values."
;; check for numbers in defaults, and nil them if need be
(if (numberp A1def) (setq A1def nil))
(if (numberp A2def) (setq A2def nil))
(Sformat-string-word-format str A1 A2 A1def A2def)
)
;;; The next few routines are for support to make writing your own
;; formating routines much easier.
(defun Sformat-string-word-format (str A1 A2 method1 method2)
"Support routine which will adjust STR by the given restrictions.
A1 and A2 are dimension bounds for the string. METHOD1 and METHOD2 define
how those dimensions are used.
A1 represents character limits, and A2 is based on words where a word is
terminated by METHOD2 regexp. A1 formatting always overrides
A2 for length. If A1 is negative, pad right, else pad left to fill to
A1 length.
Values of METHOD1 are:
'fill-only - If (length STR) < A1, pad (left or right), but do
not shorten
'fill-only-0 - As above, pad with 0
'shorten-only - If (length STR) > A1, cut back, but do not pad to
make STR A1 characters
'shorten-only-0 - A convenience
nil, 'both - If STR is too short, pad, if too long, shorten.
'both-0 - As above, padding with 0
Values of METHOD2 are:
nil, \"[a-zA-Z0-9_]*\" - cut by word, where a word includes numbers
and '_'
string (regexp) - trim out given white space replacing with
one space, with A2 words in string
'preceeding-space - if A2, the add space to beginning of str
Other notes:
The word trimmer automatically always leaves white-space in front
of each word, thus choochoo.ultranet.com => choochoo.ultranet.com,
not choochoo ultranet com."
(if (not method1) (setq method1 'both))
(if (not method2) (setq method2 "[a-zA-Z0-9_]*"))
(let* ((pad nil)
(newstr nil)
(rstr nil)
(zpad (string-match "-0" (symbol-name method1)))
(A1fl (and A1 (< A1 0)))
)
(if (and A1 (numberp A1))
(setq A1 (abs A1)))
;; first, cut by A2, if A2 exists.
(if (or (not A2) (not (stringp method2)))
(setq newstr str)
(let ((notrim (progn
(string-match "\\(\\[\\)" method2)
(concat
(substring method2 0 (match-end 1))
"^"
(substring method2 (match-end 1)))
)))
(while (and (< 0 A2) ( string-match (concat notrim
"\\("
method2
"\\)")
str))
(if newstr
(setq newstr (concat newstr
(substring str 0 (match-end 1))))
(setq newstr (substring str (match-beginning 1)
(match-end 1))))
(setq str (substring str (match-end 1)))
(setq A2 (1- A2)))))
;; Now, cut up newstr by A1 specs!
(cond
((stringp method2)
(if (not A1)
(setq rstr newstr)
(if (and (< (length newstr) A1)
(member method1 '(both both-0 fill-only fill-only-0)))
(progn
;; fill specifications
(setq pad (make-string (- A1 (length newstr)) (if zpad ?0 ? )))
(if A1fl
(setq rstr (concat newstr pad))
(setq rstr (concat pad newstr)))))
;; cut specifications
(if (and (>= (length newstr) A1)
(member method1 '(both both-0 shorten-only shorten-only-0)))
(setq rstr (substring newstr 0 A1)))))
((and (eq (eval method2) 'preceeding-space)
(integerp A2)
(not (eq A2 0))
(> (length newstr) 0))
(setq rstr (concat " " newstr)))
(t
(setq rstr newstr)))
rstr)
)
;;; Sformat string managers
;;
;; These two routines find the string between different % tokens, and
;; returns them as regular expressions vie regexp-quote. The result
;; will allow a program to find text surrounding major parts within a
;; format string.
;;
;; This is useful if you want to examine text inserted with sformat
;; and extract data stuck in originally.
(defun sformat-just-before-token-regexp (token format)
"Return a search expression for text before TOKEN in FORMAT.
This search string can be used to find the text residing in TOKEN
if it were inserted with FORMAT in the past."
(let ((rs nil) (case-fold-search nil))
(if (string-match (concat "\\(%" (char-to-string token) "\\)") format)
(progn
(setq rs (substring format 0 (match-beginning 1)))
;; scan for previous tokens and shorten
(while (string-match "\\(%\\)" rs)
(setq rs (substring rs (+ (match-end 1) 1))))
(regexp-quote rs))
nil)))
(defun sformat-just-after-token-regexp (token format)
"Return a search expression for text after TOKEN in FORMAT.
This search string can be used to find the text residing in TOKEN
if it were inserted with FORMAT in the past."
(let ((rs nil) (case-fold-search nil))
(if (string-match (concat "\\(%" (char-to-string token) "\\)") format)
(progn
(setq rs (substring format (match-end 1)))
(if (string-match "\\(%\\)" rs)
(setq rs (substring rs 0 (match-beginning 1))))
(regexp-quote rs))
nil)))
(provide 'sformat)
;;; sformat ends here
|