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

[Dave Murray]

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

Modified Files:
	slidemacs-gui.lisp gui.lisp 
Log Message:
Added :errorp nil to command-table definitions for easier reloading
during development.
Also added right-click (sets mark to previous point, point to
where clicked, and copies resulting region to kill-ring) and
middle-click (pastes from kill-ring).

Date: Tue Oct 11 23:20:52 2005
Author: dmurray

Index: climacs/slidemacs-gui.lisp
diff -u climacs/slidemacs-gui.lisp:1.19 climacs/slidemacs-gui.lisp:1.20
--- climacs/slidemacs-gui.lisp:1.19	Tue Sep 13 21:23:59 2005
+++ climacs/slidemacs-gui.lisp	Tue Oct 11 23:20:52 2005
@@ -35,7 +35,7 @@
 (defvar *current-slideset*)
 (defvar *did-display-a-slide*)
 
-(make-command-table 'slidemacs-table)
+(make-command-table 'slidemacs-table :errorp nil)
 
 (defun slidemacs-entity-string (entity)
   (coerce (buffer-sequence (buffer entity)


Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.189 climacs/gui.lisp:1.190
--- climacs/gui.lisp:1.189	Tue Sep 13 21:38:02 2005
+++ climacs/gui.lisp	Tue Oct 11 23:20:52 2005
@@ -54,39 +54,39 @@
   "If T, classic look and feel. If NIL, stripped-down look (:")
 
 ;;; Basic functionality
-(make-command-table 'base-table)
+(make-command-table 'base-table :errorp nil)
 ;;; buffers
-(make-command-table 'buffer-table)
+(make-command-table 'buffer-table :errorp nil)
 ;;; case
-(make-command-table 'case-table)
+(make-command-table 'case-table :errorp nil)
 ;;; comments
-(make-command-table 'comment-table)
+(make-command-table 'comment-table :errorp nil)
 ;;; deleting
-(make-command-table 'deletion-table)
+(make-command-table 'deletion-table :errorp nil)
 ;;; commands used for climacs development
-(make-command-table 'development-table)
+(make-command-table 'development-table :errorp nil)
 ;;; editing - making changes to a buffer
-(make-command-table 'editing-table)
+(make-command-table 'editing-table :errorp nil)
 ;;; filling
-(make-command-table 'fill-table)
+(make-command-table 'fill-table :errorp nil)
 ;;; indentation
-(make-command-table 'indent-table)
+(make-command-table 'indent-table :errorp nil)
 ;;; information about the buffer
-(make-command-table 'info-table)
+(make-command-table 'info-table :errorp nil)
 ;;; lisp-related commands
-(make-command-table 'lisp-table)
+(make-command-table 'lisp-table :errorp nil)
 ;;; marking things
-(make-command-table 'marking-table)
+(make-command-table 'marking-table :errorp nil)
 ;;; moving around
-(make-command-table 'movement-table)
+(make-command-table 'movement-table :errorp nil)
 ;;; panes
-(make-command-table 'pane-table)
+(make-command-table 'pane-table :errorp nil)
 ;;; searching
-(make-command-table 'search-table)
+(make-command-table 'search-table :errorp nil)
 ;;; self-insertion
-(make-command-table 'self-insert-table)
+(make-command-table 'self-insert-table :errorp nil)
 ;;; windows
-(make-command-table 'window-table)
+(make-command-table 'window-table :errorp nil)
 
 (define-application-frame climacs (standard-application-frame
 				   esa-frame-mixin)
@@ -618,7 +618,8 @@
 	 'movement-table
 	 '((:left :control)))
 
-(define-command (com-delete-word :name t :command-table deletion-table) ((count 'integer :prompt "Number of words"))
+(define-command (com-delete-word :name t :command-table deletion-table)
+    ((count 'integer :prompt "Number of words"))
   (delete-word (point (current-window)) count))
 
 (defun kill-word (mark &optional (count 1) (concatenate-p nil))
@@ -1579,29 +1580,65 @@
 	 'window-table
 	 '((#\x :control) (#\o)))
 
+(defun click-to-offset (window x y)
+  (with-slots (top bot) window
+       (let ((new-x (floor x (stream-character-width window #\m)))
+	     (new-y (floor y (stream-line-height window)))
+	     (buffer (buffer window)))
+	 (loop for scan from (offset top)
+	       with lines = 0
+	       until (= scan (offset bot))
+	       until (= lines new-y)
+	       when (eql (buffer-object buffer scan) #\Newline)
+		 do (incf lines)
+	       finally (loop for columns from 0
+			     until (= scan (offset bot))
+			     until (eql (buffer-object buffer scan) #\Newline)
+			     until (= columns new-x)
+			     do (incf scan))
+		       (return scan)))))
+
 (define-command (com-switch-to-this-window :name nil :command-table window-table)
     ((window 'pane) (x 'integer) (y 'integer))
   (other-window window)
-  (with-slots (top bot) window
-     (let ((new-x (floor x (stream-character-width window #\m)))
-	   (new-y (floor y (stream-line-height window)))
-	   (buffer (buffer window)))
-       (loop for scan from (offset top)
-	     with lines = 0
-	     until (= scan (offset bot))
-	     until (= lines new-y)
-	     when (eql (buffer-object buffer scan) #\Newline)
-	       do (incf lines)
-	     finally (loop for columns from 0
-			   until (= scan (offset bot))
-			   until (eql (buffer-object buffer scan) #\Newline)
-			   until (= columns new-x)
-			   do (incf scan))
-		     (setf (offset (point window)) scan)))))
+  (when (typep window 'extended-pane)
+    (setf (offset (point window))
+	  (click-to-offset window x y))))
 
 (define-presentation-to-command-translator blank-area-to-switch-to-this-window
     (blank-area com-switch-to-this-window window-table :echo nil)
-    (object window x y)
+    (window x y)
+  (list window x y))
+
+(define-gesture-name :select-other :pointer-button (:right) :unique nil)
+
+(define-command (com-mouse-save :name nil :command-table window-table)
+    ((window 'pane) (x 'integer) (y 'integer))
+  (when (and (typep window 'extended-pane)
+	     (eq window (current-window)))
+    (setf (offset (mark window))
+	  (click-to-offset window x y))
+    (com-exchange-point-and-mark)
+    (com-copy-region)))
+
+(define-presentation-to-command-translator blank-area-to-mouse-save
+    (blank-area com-mouse-save window-table :echo nil :gesture :select-other)
+    (window x y)
+  (list window x y))
+
+(define-gesture-name :middle-button :pointer-button (:middle) :unique nil)
+
+(define-command (com-yank-here :name nil :command-table window-table)
+    ((window 'pane) (x 'integer) (y 'integer))
+  (when (typep window 'extended-pane)
+    (other-window window)
+    (setf (offset (point window))
+	  (click-to-offset window x y))
+    (com-yank)))
+
+(define-presentation-to-command-translator blank-area-to-yank-here
+    (blank-area com-yank-here window-table :echo nil :gesture :middle-button)
+    (window x y)
   (list window x y))
 
 (defun single-window ()