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

[Nikodemus Siivola]

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

Modified Files:
	command-functions.lisp command-keys.lisp 
Log Message:
Change describe-word to M-I, bind M-U and M-D to upcase-word and downcase-word.
Date: Mon Oct 20 14:14:32 2003
Author: nsiivola

Index: src/command-functions.lisp
diff -u src/command-functions.lisp:1.6 src/command-functions.lisp:1.7
--- src/command-functions.lisp:1.6	Mon Oct 20 11:34:02 2003
+++ src/command-functions.lisp	Mon Oct 20 14:14:31 2003
@@ -68,6 +68,24 @@
   (declare (ignore chord editor))
   (throw 'linedit-done t))
 
+;;; CASE CHANGES
+
+(flet ((frob-case (frob editor)
+	 (with-editor-point-and-string ((point string) editor)
+	   (let ((end (editor-word-end editor)))
+	     (setf (get-string editor) (concat (subseq string 0 point)
+					       (funcall frob (subseq string point end))
+					       (subseq string end))
+		   (get-point editor) end)))))
+
+  (defun upcase-word (chord editor)
+    (declare (ignore chord))
+    (funcall #'frob-case #'string-upcase editor))
+
+  (defun downcase-word (chord editor)
+    (declare (ignore chord))
+    (funcall #'frob-case #'string-downcase editor)))
+
 ;;; MOVEMENT
 
 (defun move-to-bol (chord editor)


Index: src/command-keys.lisp
diff -u src/command-keys.lisp:1.5 src/command-keys.lisp:1.6
--- src/command-keys.lisp:1.5	Mon Oct 20 13:49:05 2003
+++ src/command-keys.lisp	Mon Oct 20 14:14:31 2003
@@ -55,12 +55,12 @@
 (defcommand "M-A" 'apropos-word)
 (defcommand "M-B" 'move-word-backwards)
 (defcommand "M-C")
-(defcommand "M-D" 'describe-word)
+(defcommand "M-D" 'downcase-word)
 (defcommand "M-E")
 (defcommand "M-F" 'move-word-forwards)
 (defcommand "M-G")
 (defcommand "M-H" 'help)
-(defcommand "M-I")
+(defcommand "M-I" 'describe-word)
 (defcommand "M-J")
 (defcommand "M-K")
 (defcommand "M-L")
@@ -72,7 +72,7 @@
 (defcommand "M-R")
 (defcommand "M-S")
 (defcommand "M-T")
-(defcommand "M-U")
+(defcommand "M-U" 'upcase-word)
 (defcommand "M-V")
 (defcommand "M-W" 'copy-region)
 (defcommand "M-X")