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 ()
