[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp climacs/packages.lisp

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv14833

Modified Files:
	base.lisp gui.lisp packages.lisp 
Log Message:
New commands:

M-m          (back to indentation)
M-d          (delete word)
M-backspace  (backward delete word)
M-x goto-position
M-x goto-line

New function whitespacep. 

Used `:name t' instead of repeating the command name in 
define-command. 


Date: Wed Dec 29 17:03:22 2004
Author: rstrandh

Index: climacs/base.lisp
diff -u climacs/base.lisp:1.6 climacs/base.lisp:1.7
--- climacs/base.lisp:1.6	Mon Dec 27 12:32:46 2004
+++ climacs/base.lisp	Wed Dec 29 17:03:21 2004
@@ -93,6 +93,12 @@
        #+sbcl (sb-impl::constituentp obj)
        #-sbcl (alphanumericp obj)))
 
+(defun whitespacep (obj)
+  "A predicate to ensure that an object is a whitespace character."
+  (and (characterp obj)
+       #+sbcl (sb-impl::whitespacep obj)
+       #-sbcl (member obj '(#\Space #\Tab))))
+
 (defun forward-word (mark)
   "Forward the mark to the next word."
   (loop until (end-of-buffer-p mark)
@@ -110,4 +116,22 @@
   (loop until (beginning-of-buffer-p mark)
 	while (constituentp (object-before mark))
 	do (decf (offset mark))))
+
+(defun delete-word (mark)
+  "Delete until the end of the word"
+  (loop until (end-of-buffer-p mark)
+	until (constituentp (object-after mark))
+	do (incf (offset mark)))
+  (loop until (end-of-buffer-p mark)
+	while (constituentp (object-after mark))
+	do (delete-range mark)))
+
+(defun backward-delete-word (mark)
+  "Delete until the beginning of the word"
+  (loop until (beginning-of-buffer-p mark)
+	until (constituentp (object-before mark))
+	do (decf (offset mark)))
+  (loop until (beginning-of-buffer-p mark)
+	while (constituentp (object-before mark))
+	do (delete-range mark -1)))
 


Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.31 climacs/gui.lisp:1.32
--- climacs/gui.lisp:1.31	Wed Dec 29 09:02:45 2004
+++ climacs/gui.lisp	Wed Dec 29 17:03:21 2004
@@ -157,7 +157,7 @@
 		 (setf (needs-saving buffer) t)))
 	     (redisplay-frame-panes frame))))
 
-(define-command (com-quit :name "Quit" :command-table climacs) ()
+(define-command (com-quit :name t :command-table climacs) ()
   (frame-exit *application-frame*))
 
 (define-command com-self-insert ()
@@ -201,6 +201,12 @@
 (define-command com-backward-word ()
   (backward-word (point (win *application-frame*))))
 
+(define-command com-delete-word ()
+  (delete-word (point (win *application-frame*))))
+
+(define-command com-backward-delete-word ()
+  (backward-delete-word (point (win *application-frame*))))
+
 (define-command com-toggle-layout ()
   (setf (frame-current-layout *application-frame*)
 	(if (eq (frame-current-layout *application-frame*) 'default)
@@ -290,7 +296,7 @@
       (concatenate 'string (pathname-name pathname)
 		   "." (pathname-type pathname))))
 
-(define-command (com-find-file :name "Find File" :command-table climacs) ()
+(define-command (com-find-file :name t :command-table climacs) ()
   (let ((filename (accept 'completable-pathname
 			  :prompt "Find File")))
     (with-slots (buffer point syntax) (win *application-frame*)
@@ -339,6 +345,29 @@
 (define-command com-end-of-buffer ()
   (end-of-buffer (point (win *application-frame*))))
 
+(define-command com-back-to-indentation ()
+  (let ((point (point (win *application-frame*))))
+    (beginning-of-line point)
+    (loop until (end-of-line-p point)
+	  while (whitespacep (object-after point))
+	  do (incf (offset point)))))
+
+(define-command (com-goto-position :name t :command-table climacs) ()
+  (setf (offset (point (win *application-frame*)))
+	(accept 'integer :prompt "Goto Position")))
+
+(define-command (com-goto-line :name t :command-table climacs) ()
+  (loop with mark = (make-instance 'standard-right-sticky-mark
+		       :buffer (buffer (win *application-frame*)))
+	do (end-of-line mark)
+	until (end-of-buffer-p mark)
+	repeat (accept 'integer :prompt "Goto Line")
+	do (incf (offset mark))
+	   (end-of-line mark)
+	finally (beginning-of-line mark)
+		(setf (offset (point (win *application-frame*)))
+		      (offset mark))))
+
 (define-command com-browse-url ()
   (accept 'url :prompt "Browse URL"))
 
@@ -424,6 +453,9 @@
 (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer)
 (global-set-key '(#\> :shift :meta) 'com-end-of-buffer)
 (global-set-key '(#\u :meta) 'com-browse-url)
+(global-set-key '(#\m :meta) 'com-back-to-indentation)
+(global-set-key '(#\d :meta) 'com-delete-word)
+(global-set-key '(#\Backspace :meta) 'com-backward-delete-word)
 
 (global-set-key '(:up) 'com-previous-line)
 (global-set-key '(:down) 'com-next-line)


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.14 climacs/packages.lisp:1.15
--- climacs/packages.lisp:1.14	Wed Dec 29 08:06:46 2004
+++ climacs/packages.lisp	Wed Dec 29 17:03:21 2004
@@ -45,8 +45,9 @@
   (:export #:previous-line #:next-line
 	   #:open-line #:kill-line
 	   #:number-of-lines-in-region
-	   #:constituentp
+	   #:constituentp #:whitespacep
 	   #:forward-word #:backward-word
+	   #:delete-word #:backward-delete-word
 	   #:input-from-stream #:output-to-stream))
 
 (defpackage :climacs-abbrev