| ... |
... |
@@ -339,16 +339,54 @@ |
|
339
|
339
|
(defun help-switch-demon (switch)
|
|
340
|
340
|
(declare (ignore switch))
|
|
341
|
341
|
(format t (intl:gettext "~&Usage: ~A <options>~2%") *command-line-utility-name*)
|
|
342
|
|
- (dolist (s (sort *legal-cmd-line-switches* #'string<
|
|
343
|
|
- :key #'car))
|
|
344
|
|
- (destructuring-bind (name doc arg)
|
|
345
|
|
- s
|
|
346
|
|
- (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg)))
|
|
347
|
|
- ;; Poor man's formatting of the help string
|
|
348
|
|
- (with-input-from-string (stream (intl:gettext doc))
|
|
349
|
|
- (loop for line = (read-line stream nil nil)
|
|
350
|
|
- while line
|
|
351
|
|
- do (format t "~8T~A~%" line)))))
|
|
|
342
|
+ (flet
|
|
|
343
|
+ ((get-words (s)
|
|
|
344
|
+ (declare (string s))
|
|
|
345
|
+ ;; Return a list of all the words from S. A word is defined
|
|
|
346
|
+ ;; as any sequence of characters separated from others by
|
|
|
347
|
+ ;; whitespace consisting of space, newline, tab, formfeed, or
|
|
|
348
|
+ ;; carriage return.
|
|
|
349
|
+ (let ((end (length s)))
|
|
|
350
|
+ (loop for left = 0 then (+ right 1)
|
|
|
351
|
+ for right = (or
|
|
|
352
|
+ (position-if #'(lambda (c)
|
|
|
353
|
+ (member c
|
|
|
354
|
+ '(#\space #\newline #\tab #\ff #\cr)))
|
|
|
355
|
+ s
|
|
|
356
|
+ :start left)
|
|
|
357
|
+ end)
|
|
|
358
|
+ ;; Collect the word bounded by left and right in a list.
|
|
|
359
|
+ unless (and (= right left))
|
|
|
360
|
+ collect (subseq s left right) into subseqs
|
|
|
361
|
+ ;; Keep going until we reach the end of the string.
|
|
|
362
|
+ until (>= right end)
|
|
|
363
|
+ finally (return subseqs)))))
|
|
|
364
|
+
|
|
|
365
|
+ (dolist (s (sort *legal-cmd-line-switches* #'string<
|
|
|
366
|
+ :key #'car))
|
|
|
367
|
+ (destructuring-bind (name doc arg)
|
|
|
368
|
+ s
|
|
|
369
|
+ (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg)))
|
|
|
370
|
+ ;; Poor man's formatting of the help string
|
|
|
371
|
+ (let ((*print-right-margin* 80))
|
|
|
372
|
+ ;; Extract all the words from the string and print them out
|
|
|
373
|
+ ;; one by one with a space between each, wrapping the output
|
|
|
374
|
+ ;; if needed. Each line is indented by 8 spaces.
|
|
|
375
|
+ ;;
|
|
|
376
|
+ ;; "~@< ~@;"
|
|
|
377
|
+ ;; per-line prefix of spaces and pass the whole arg list
|
|
|
378
|
+ ;; to this directive.
|
|
|
379
|
+ ;;
|
|
|
380
|
+ ;; "~{~A~^ ~}"
|
|
|
381
|
+ ;; loop over each word and print out the word followed by
|
|
|
382
|
+ ;; a space.
|
|
|
383
|
+ ;;
|
|
|
384
|
+ ;; "~:@>"
|
|
|
385
|
+ ;; No suffix, and insert conditional newline after each
|
|
|
386
|
+ ;; group of blanks if needed.
|
|
|
387
|
+ (format t "~@< ~@;~{~A~^ ~}~:@>"
|
|
|
388
|
+ (get-words (intl:gettext doc))))
|
|
|
389
|
+ (terpri))))
|
|
352
|
390
|
(ext:quit))
|
|
353
|
391
|
|
|
354
|
392
|
(defswitch "help" #'help-switch-demon
|