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

[Robert Strandh]

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

Modified Files:
	base.lisp gui.lisp 
Log Message:
The functions forward-word and backward-word now thake an
optional count argument.

The corresponding Climacs command now accept numeric arguments.


Date: Fri Jan 28 22:53:45 2005
Author: rstrandh

Index: climacs/base.lisp
diff -u climacs/base.lisp:1.26 climacs/base.lisp:1.27
--- climacs/base.lisp:1.26	Fri Jan 28 10:47:29 2005
+++ climacs/base.lisp	Fri Jan 28 22:53:44 2005
@@ -178,19 +178,21 @@
 	until (constituentp (object-before mark))
 	do (decf (offset mark))))
 
-(defun forward-word (mark)
+(defun forward-word (mark &optional (count 1))
   "Forward the mark to the next word."
-  (forward-to-word-boundary mark)
-  (loop until (end-of-buffer-p mark)
-	while (constituentp (object-after mark))
-	do (incf (offset mark))))
+  (loop repeat count
+	do (forward-to-word-boundary mark)
+	   (loop until (end-of-buffer-p mark)
+		 while (constituentp (object-after mark))
+		 do (incf (offset mark)))))
 
-(defun backward-word (mark)
+(defun backward-word (mark &optional (count 1))
   "Shuttle the mark to the start of the previous word."
-  (backward-to-word-boundary mark)
-  (loop until (beginning-of-buffer-p mark)
-	while (constituentp (object-before mark))
-	do (decf (offset mark))))
+  (loop repeat count
+	do (backward-to-word-boundary mark)
+	   (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"


Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.101 climacs/gui.lisp:1.102
--- climacs/gui.lisp:1.101	Fri Jan 28 10:47:29 2005
+++ climacs/gui.lisp	Fri Jan 28 22:53:44 2005
@@ -465,11 +465,11 @@
 			       (region-to-sequence mark point)))
     (delete-region mark point)))
 
-(define-named-command com-forward-word ()
-  (forward-word (point (current-window))))
+(define-named-command com-forward-word ((count 'integer :prompt "Number of words"))
+  (forward-word (point (current-window)) count))
 
-(define-named-command com-backward-word ()
-  (backward-word (point (current-window))))
+(define-named-command com-backward-word ((count 'integer :prompt "Number of words"))
+  (backward-word (point (current-window)) count))
 
 (define-named-command com-delete-word ()
   (delete-word (point (current-window))))
@@ -1268,8 +1268,8 @@
 (global-set-key '(#\Space :control) 'com-set-mark)
 (global-set-key '(#\y :control) 'com-yank)
 (global-set-key '(#\w :control) 'com-cut-out)
-(global-set-key '(#\f :meta) 'com-forward-word)
-(global-set-key '(#\b :meta) 'com-backward-word)
+(global-set-key '(#\f :meta) `(com-forward-word ,*numeric-argument-marker*))
+(global-set-key '(#\b :meta) `(com-backward-word ,*numeric-argument-marker*))
 (global-set-key '(#\t :meta) 'com-transpose-words)
 (global-set-key '(#\u :meta) 'com-upcase-word)
 (global-set-key '(#\l :meta) 'com-downcase-word)
@@ -1297,8 +1297,8 @@
 (global-set-key '(:down) 'com-next-line)
 (global-set-key '(:left) `(com-backward-object ,*numeric-argument-marker*))
 (global-set-key '(:right) `(com-forward-object ,*numeric-argument-marker*))
-(global-set-key '(:left :control) 'com-backward-word)
-(global-set-key '(:right :control) 'com-forward-word)
+(global-set-key '(:left :control) `(com-backward-word ,*numeric-argument-marker*))
+(global-set-key '(:right :control) `(com-forward-word ,*numeric-argument-marker*))
 (global-set-key '(:home) 'com-beginning-of-line)
 (global-set-key '(:end) 'com-end-of-line)
 (global-set-key '(:prior) 'com-page-up)