[Git][cmucl/cmucl][master] 2 commits: Fix #155: Wrap help strings neatly

[Raymond Toy (@rtoy)]

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/317a33f8d4031fd15c854e0700b5c1be1df0900d...68f4ec706ced2efdf3e17f881adf01cd16f5e0c5

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/317a33f8d4031fd15c854e0700b5c1be1df0900d...68f4ec706ced2efdf3e17f881adf01cd16f5e0c5
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20221108/ec6c81df/attachment-0001.html>