Raymond Toy pushed to branch master at cmucl / cmucl Commits: 7bbb4843 by Raymond Toy at 2022-11-08T03:19:19+00:00 Fix #155: Wrap help strings neatly - - - - - 68f4ec70 by Raymond Toy at 2022-11-08T03:19:21+00:00 Merge branch 'issue-155-wrap-help-strings' into 'master' Fix #155: Wrap help strings neatly Closes #155 See merge request cmucl/cmucl!107 - - - - - 2 changed files: - src/code/commandline.lisp - src/general-info/release-21e.md Changes: ===================================== src/code/commandline.lisp ===================================== @@ -339,16 +339,54 @@ (defun help-switch-demon (switch) (declare (ignore switch)) (format t (intl:gettext "~&Usage: ~A <options>~2%") *command-line-utility-name*) - (dolist (s (sort *legal-cmd-line-switches* #'string< - :key #'car)) - (destructuring-bind (name doc arg) - s - (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg))) - ;; Poor man's formatting of the help string - (with-input-from-string (stream (intl:gettext doc)) - (loop for line = (read-line stream nil nil) - while line - do (format t "~8T~A~%" line))))) + (flet + ((get-words (s) + (declare (string s)) + ;; Return a list of all the words from S. A word is defined + ;; as any sequence of characters separated from others by + ;; whitespace consisting of space, newline, tab, formfeed, or + ;; carriage return. + (let ((end (length s))) + (loop for left = 0 then (+ right 1) + for right = (or + (position-if #'(lambda (c) + (member c + '(#\space #\newline #\tab #\ff #\cr))) + s + :start left) + end) + ;; Collect the word bounded by left and right in a list. + unless (and (= right left)) + collect (subseq s left right) into subseqs + ;; Keep going until we reach the end of the string. + until (>= right end) + finally (return subseqs))))) + + (dolist (s (sort *legal-cmd-line-switches* #'string< + :key #'car)) + (destructuring-bind (name doc arg) + s + (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg))) + ;; Poor man's formatting of the help string + (let ((*print-right-margin* 80)) + ;; Extract all the words from the string and print them out + ;; one by one with a space between each, wrapping the output + ;; if needed. Each line is indented by 8 spaces. + ;; + ;; "~@< ~@;" + ;; per-line prefix of spaces and pass the whole arg list + ;; to this directive. + ;; + ;; "~{~A~^ ~}" + ;; loop over each word and print out the word followed by + ;; a space. + ;; + ;; "~:@>" + ;; No suffix, and insert conditional newline after each + ;; group of blanks if needed. + (format t "~@< ~@;~{~A~^ ~}~:@>" + (get-words (intl:gettext doc)))) + (terpri)))) (ext:quit)) (defswitch "help" #'help-switch-demon ===================================== src/general-info/release-21e.md ===================================== @@ -63,6 +63,7 @@ public domain. * ~~#142~~ `(random 0)` signals incorrect error * ~~#147~~ `stream-line-column` method missing for `fundamental-character-output-stream` * ~~#149~~ Call setlocale(3C) on startup + * ~~#155~~ Wrap help strings neatly * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/317a33f8d4031fd15c854e0... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/317a33f8d4031fd15c854e0... You're receiving this email because of your account on gitlab.common-lisp.net.