Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv15124
Modified Files: climacs.asd gui.lisp packages.lisp Added Files: kill-ring.lisp Log Message: adding in kill ring material Date: Wed Dec 29 06:45:38 2004 Author: ejohnson
Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.5 climacs/climacs.asd:1.6 --- climacs/climacs.asd:1.5 Sat Dec 25 00:14:40 2004 +++ climacs/climacs.asd Wed Dec 29 06:45:37 2004 @@ -55,4 +55,5 @@ "io" "abbrev" "syntax" + "kill-ring" "gui")
Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.24 climacs/gui.lisp:1.25 --- climacs/gui.lisp:1.24 Wed Dec 29 05:55:20 2004 +++ climacs/gui.lisp Wed Dec 29 06:45:37 2004 @@ -34,14 +34,18 @@ (defclass climacs-pane (application-pane) ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) (point :initform nil :initarg :point :reader point) - (syntax :initarg :syntax :accessor syntax))) + (syntax :initarg :syntax :accessor syntax) + (mark :initform nil :initarg :mark :reader mark)))
(defmethod initialize-instance :after ((pane climacs-pane) &rest args) (declare (ignore args)) - (with-slots (buffer point syntax) pane + (with-slots (buffer point syntax mark) pane (when (null point) (setf point (make-instance 'standard-right-sticky-mark :buffer buffer))) + (when (null mark) + (setf mark (make-instance 'standard-right-sticky-mark + :buffer buffer))) (setf syntax (make-instance 'texinfo-syntax :pane pane))))
(define-application-frame climacs () @@ -96,6 +100,7 @@ (setf table (command-menu-item-value item))) finally (return item)))
+(defvar *kill-ring* (initialize-kill-ring 7)) (defparameter *current-gesture* nil)
(defun climacs-top-level (frame &key @@ -331,6 +336,49 @@ (define-command com-browse-url () (accept 'url :prompt "Browse URL"))
+(define-command com-set-mark () + (with-slots (point mark) (win *application-frame*) + (setf mark (clone-mark point)))) + +;;;;;;;;;;;;;;;;;;;; +;; Kill ring commands + +;; The naming may sound odd here, but think of electronic wireing: +;; outputs to inputs and inputs to outputs. Copying into a buffer +;; first requires coping out of the kill ring. + +(define-command com-copy-in () + (kr-copy-out (point (win *application-frame*)) *kill-ring*)) + +(define-command com-cut-in () + (kr-cut-out (point (win *application-frame*)) *kill-ring*)) + +(define-command com-cut-out () + (with-slots (buffer point mark)(win *application-frame*) + (let ((off1 (offset point)) + (off2 (offset mark))) + (if (< off1 off2) + (kr-cut-in buffer *kill-ring* off1 off2) + (kr-cut-in buffer *kill-ring* off2 off1))))) + +(define-command com-copy-out () + (with-slots (buffer point mark)(win *application-frame*) + (let ((off1 (offset point)) + (off2 (offset mark))) + (if (< off1 off2) + (kr-copy-in buffer *kill-ring* off1 off2) + (kr-copy-in buffer *kill-ring* off2 off1))))) + +;; Needs adjustment to be like emacs M-y +(define-command com-kr-rotate () + (kr-rotate *kill-ring* -1)) + +;; Not bound to a key yet +(define-command com-kr-resize () + (let ((size (accept 'fixnum :prompt "New kill ring size: "))) + (kr-resize *kill-ring* size))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Global command table @@ -355,11 +403,16 @@ (global-set-key '(#\n :control) 'com-next-line) (global-set-key '(#\o :control) 'com-open-line) (global-set-key '(#\k :control) 'com-kill-line) +(global-set-key '(#\Space :control) 'com-set-mark) +(global-set-key '(#\y :control) 'com-copy-in) +(global-set-key '(#\w :control) 'com-cut-in) (global-set-key '(#\f :meta) 'com-forward-word) (global-set-key '(#\b :meta) 'com-backward-word) (global-set-key '(#\x :meta) 'com-extended-command) (global-set-key '(#\a :meta) 'com-insert-weird-stuff) (global-set-key '(#\c :meta) 'com-insert-reversed-string) +(global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only +(global-set-key '(#\w :meta) 'com-copy-out) (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)
Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.11 climacs/packages.lisp:1.12 --- climacs/packages.lisp:1.11 Sun Dec 26 08:18:01 2004 +++ climacs/packages.lisp Wed Dec 29 06:45:37 2004 @@ -60,6 +60,12 @@ #:redisplay-pane #:redisplay-with-syntax #:full-redisplay #:url))
+(defpackage :climacs-kill-ring + (:use :clim-lisp :climacs-buffer :flexichain) + (:export #:initialize-kill-ring #:kr-length #:kr-resize + #:kr-rotate #:kr-copy-in #:kr-cut-in #:kr-copy-out + #:kr-cut-out)) + (defpackage :climacs-gui - (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax)) + (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax :climacs-kill-ring))