[Linedit-cvs] CVS update: src/command-functions.lisp src/command-keys.lisp src/complete.lisp src/terminal-translations.lisp

[Julian E. C. Squires]

Update of /project/linedit/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv21248

Modified Files:
	command-functions.lisp command-keys.lisp complete.lisp 
	terminal-translations.lisp 
Log Message:
Added unimplemented stubs for sexp motion commands.
 * Added homedir (~ and ~user) completion.  Requires latest osicat.
 * Added preliminary close-all-sexps, bound to C-O.

Date: Thu Apr 22 22:33:19 2004
Author: jsquires

Index: src/command-functions.lisp
diff -u src/command-functions.lisp:1.9 src/command-functions.lisp:1.10
--- src/command-functions.lisp:1.9	Fri Mar  5 04:34:00 2004
+++ src/command-functions.lisp	Thu Apr 22 22:33:18 2004
@@ -200,6 +200,26 @@
   ;; accessors.  Why? Was I not thinking, or am I not thinking now?
   (setf (editor-mark editor) (get-point editor)))
 
+;;; SEXP MOTION
+
+;; FIXME: all of these only operate on the current editing line.
+;; Also, obviously, all save close-all-sexp are unimplemented.
+
+(defun forward-sexp (chord editor)
+  (declare (ignore chord editor)) nil)
+
+(defun backward-sexp (chord editor)
+  (declare (ignore chord editor)) nil)
+
+(defun kill-sexp (chord editor)
+  (declare (ignore chord editor)) nil)
+
+(defun close-all-sexp (chord editor)
+  (move-to-eol chord editor)
+  (do ((string (get-string editor) (get-string editor)))
+      ((not (find-open-paren string (length string))))
+    (add-char #\) editor)))
+
 ;;; SIGNALS
 
 (defun interrupt-lisp (chord editor)


Index: src/command-keys.lisp
diff -u src/command-keys.lisp:1.6 src/command-keys.lisp:1.7
--- src/command-keys.lisp:1.6	Mon Oct 20 14:14:31 2003
+++ src/command-keys.lisp	Thu Apr 22 22:33:18 2004
@@ -38,7 +38,7 @@
 (defcommand "C-K" 'kill-to-eol)
 (defcommand "C-L")
 (defcommand "C-N" 'history-next)
-(defcommand "C-O")
+(defcommand "C-O" 'close-all-sexp)
 (defcommand "C-P" 'history-previous)
 (defcommand "C-Q")
 (defcommand "C-R")
@@ -88,6 +88,10 @@
 (defcommand "M-8")
 (defcommand "M-9")
 (defcommand "M-0")
+
+(defcommand "C-M-b" 'backward-sexp)
+(defcommand "C-M-f" 'forward-sexp)
+(defcommand "C-M-k" 'kill-sexp)
 
 (defcommand "C-Space" 'set-mark)
 (defcommand "C-Backspace" 'delete-word-backwards)


Index: src/complete.lisp
diff -u src/complete.lisp:1.6 src/complete.lisp:1.7
--- src/complete.lisp:1.6	Mon Apr 12 08:38:41 2004
+++ src/complete.lisp	Thu Apr 22 22:33:18 2004
@@ -83,12 +83,31 @@
 			  (<= (length common) (length string)))
 		      (return (values all max))
 		      (return (values (list common) (length common))))))))))))))))
-	  
+
+;; We can't easily do zsh-style tab-completion of ~us into ~user, but
+;; at least we can expand ~ and ~user.  The other bug here at the
+;; moment is that ~nonexistant will complete to the same as ~.
+(defun tilde-expand-string (string)
+  "Returns the supplied string, with a prefix of ~ or ~user expanded
+to the appropriate home directory."
+  (if (and (> (length string) 0)
+	   (eql (schar string 0) #\~))
+      (flet ((chop (s) (subseq s 0 (1- (length s)))))
+	(let* ((slash-idx (loop for i below (length string)
+				when (eql (schar string i) #\/) return i))
+	       (suffix (and slash-idx (subseq string slash-idx)))
+	       (uname (subseq string 1 slash-idx))
+	       (homedir (or (cdr (assoc :home (osicat:user-info uname)))
+			    (chop (namestring (user-homedir-pathname))))))
+	(concatenate 'string homedir (or suffix ""))))
+      string))
+
 (defun directory-complete (string)
   (declare (simple-string string))
   (let* ((common nil)
 	 (all nil)
 	 (max 0)
+	 (string (tilde-expand-string string))
 	 (dir (pathname-directory-pathname string))
 	 (namefun (if (relative-pathname-p string)
 		      #'namestring


Index: src/terminal-translations.lisp
diff -u src/terminal-translations.lisp:1.5 src/terminal-translations.lisp:1.6
--- src/terminal-translations.lisp:1.5	Mon Apr 12 09:34:50 2004
+++ src/terminal-translations.lisp	Thu Apr 22 22:33:18 2004
@@ -96,6 +96,10 @@
 (deftrans "M-8" (#\Esc #\8) 184)
 (deftrans "M-9" (#\Esc #\9) 185)
 
+(deftrans "C-M-f" (#\Esc #\Ack))
+(deftrans "C-M-b" (#\Esc #\Stx))
+(deftrans "C-M-k" (#\Esc #\Vt)) 
+
 (deftrans "Up-arrow"    (#\Esc #\[ #\A))
 (deftrans "Down-arrow"  (#\Esc #\[ #\B))
 (deftrans "Right-arrow" (#\Esc #\[ #\C))