From ef8b4cc15c2a2a9aa87d771bccacbf3b5c2d70e4 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Fri, 25 Oct 1991 23:10:16 +0000
Subject: [PATCH] Fixed the :file branch of "Help on Parse" to trim leading
 directory components off the pathname if it wouldn't otherwise fit on the
 screen.

---
 hemlock/echocoms.lisp | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/hemlock/echocoms.lisp b/hemlock/echocoms.lisp
index 1bf1155bc..a857af6a8 100644
--- a/hemlock/echocoms.lisp
+++ b/hemlock/echocoms.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/echocoms.lisp,v 1.1.1.5 1991/02/08 16:34:09 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/echocoms.lisp,v 1.1.1.6 1991/10/25 23:10:16 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -88,9 +88,20 @@
 	  (write-line help s)
 	  (cond (pns
 		 (write-line "Possible completions of what you have typed:" s)
-		 (dolist (pn pns)
-		   (format s " ~A~25T ~A~%" (file-namestring pn)
-			   (directory-namestring pn))))
+		 (let ((width (- (window-width (current-window)) 27)))
+		   (dolist (pn pns)
+		     (let* ((dir (directory-namestring pn))
+			    (len (length dir)))
+		       (unless (<= len width)
+			 (let ((slash (position #\/ dir
+						:start (+ (- len width) 3))))
+			   (setf dir
+				 (if slash
+				     (concatenate 'string "..."
+						  (subseq dir slash))
+				     "..."))))
+		       (format s " ~A~25T ~A~%"
+			       (file-namestring pn) dir)))))
 		(t
 		 (write-line 
  "There are no possible completions of what you have typed." s))))))
-- 
GitLab