Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv16088 Modified Files: packages.lisp lisp-syntax.lisp kill-ring.lisp gui.lisp Log Message: Added com-just-one-space (M-Space), com-scroll-other-window-up (C-M-V), com-append-next-kill (M-C-w). Also, I think I've fixed expression-navigation funkiness. Date: Sun Aug 14 20:09:42 2005 Author: dmurray Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.75 climacs/packages.lisp:1.76 --- climacs/packages.lisp:1.75 Sun Aug 14 14:12:35 2005 +++ climacs/packages.lisp Sun Aug 14 20:09:42 2005 @@ -122,7 +122,8 @@ (defpackage :climacs-kill-ring (:use :clim-lisp :flexichain) - (:export #:kill-ring #:kill-ring-length #:kill-ring-max-size + (:export #:kill-ring #:kill-ring-length #:kill-ring-max-size + #:append-next-p #:reset-yank-position #:rotate-yank-position #:kill-ring-yank #:kill-ring-standard-push #:kill-ring-concatenating-push #:kill-ring-reverse-concatenating-push)) Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.28 climacs/lisp-syntax.lisp:1.29 --- climacs/lisp-syntax.lisp:1.28 Sun Aug 14 10:56:58 2005 +++ climacs/lisp-syntax.lisp Sun Aug 14 20:09:42 2005 @@ -1393,7 +1393,9 @@ ((and (>= offset (end-offset first)) (or (null rest) (<= offset (start-offset (first-form rest))))) - (return (let ((potential-form (form-before-in-children (children first) offset))) + (return (let ((potential-form + (when (typep first 'list-form) + (form-before-in-children (children first) offset)))) (or potential-form (when (typep first 'form) first))))) @@ -1438,7 +1440,7 @@ ((<= offset (start-offset child)) (return nil)) (t nil)))) - + (defun form-around (syntax offset) (with-slots (stack-top) syntax (if (or (null (start-offset stack-top)) Index: climacs/kill-ring.lisp diff -u climacs/kill-ring.lisp:1.7 climacs/kill-ring.lisp:1.8 --- climacs/kill-ring.lisp:1.7 Fri Aug 5 14:40:56 2005 +++ climacs/kill-ring.lisp Sun Aug 14 20:09:42 2005 @@ -31,7 +31,9 @@ :accessor kill-ring-chain :initform (make-instance 'standard-cursorchain)) (yankpoint :type left-sticky-flexicursor - :accessor kill-ring-cursor)) + :accessor kill-ring-cursor) + (append-next-p :type boolean :initform nil + :accessor append-next-p)) (:documentation "A class for all kill rings")) (defmethod initialize-instance :after((kr kill-ring) &rest args) @@ -115,14 +117,17 @@ (setf (cursor-pos curs) pos)))) (defmethod kill-ring-standard-push ((kr kill-ring) vector) - (let ((chain (kill-ring-chain kr))) - (if (>= (kill-ring-length kr) - (kill-ring-max-size kr)) - (progn - (pop-end chain) - (push-start chain vector)) - (push-start chain vector))) - (reset-yank-position kr)) + (cond ((append-next-p kr) + (kill-ring-concatenating-push kr vector) + (setf (append-next-p kr) nil)) + (t (let ((chain (kill-ring-chain kr))) + (if (>= (kill-ring-length kr) + (kill-ring-max-size kr)) + (progn + (pop-end chain) + (push-start chain vector)) + (push-start chain vector))) + (reset-yank-position kr)))) (defmethod kill-ring-concatenating-push ((kr kill-ring) vector) (let ((chain (kill-ring-chain kr))) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.175 climacs/gui.lisp:1.176 --- climacs/gui.lisp:1.175 Sun Aug 14 14:11:21 2005 +++ climacs/gui.lisp Sun Aug 14 20:09:42 2005 @@ -797,6 +797,20 @@ do (forward-object mark))) (delete-region point mark))) +(define-named-command com-just-one-space ((count 'integer :prompt "Number of spaces")) + (let ((point (point (current-window))) + offset) + (loop until (beginning-of-line-p point) + while (whitespacep (object-before point)) + do (backward-object point)) + (loop until (end-of-line-p point) + while (whitespacep (object-after point)) + repeat count do (forward-object point) + finally (setf offset (offset point))) + (loop until (end-of-line-p point) + while (whitespacep (object-after point)) + do (forward-object point)) + (delete-region offset point))) (define-named-command com-goto-position () (setf (offset (point (current-window))) @@ -958,6 +972,11 @@ (when other-window (page-down other-window)))) +(define-named-command com-scroll-other-window-up () + (let ((other-window (second (windows *application-frame*)))) + (when other-window + (page-up other-window)))) + (define-named-command com-delete-window () (unless (null (cdr (windows *application-frame*))) (let* ((constellation (if *with-scrollbars* @@ -1023,6 +1042,9 @@ (return-from com-resize-kill-ring nil)))))) (setf (kill-ring-max-size *kill-ring*) size))) +(define-named-command com-append-next-kill () + (setf (append-next-p *kill-ring*) t)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Incremental search @@ -1662,6 +1684,7 @@ (global-set-key '(#\Space :control) 'com-set-mark) (global-set-key '(#\y :control) 'com-yank) (global-set-key '(#\w :control) 'com-kill-region) +(global-set-key '(#\w :control :meta) 'com-append-next-kill) (global-set-key '(#\e :meta) `(com-forward-sentence ,*numeric-argument-marker*)) (global-set-key '(#\a :meta) `(com-backward-sentence ,*numeric-argument-marker*)) (global-set-key '(#\k :meta) `(com-kill-sentence ,*numeric-argument-marker*)) @@ -1678,10 +1701,12 @@ (global-set-key '(#\v :control) 'com-page-down) (global-set-key '(#\v :meta) 'com-page-up) (global-set-key '(#\v :control :meta) 'com-scroll-other-window) +(global-set-key '(#\V :control :meta :shift) 'com-scroll-other-window-up) (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) (global-set-key '(#\> :shift :meta) 'com-end-of-buffer) (global-set-key '(#\m :meta) 'com-back-to-indentation) (global-set-key '(#\\ :meta) `(com-delete-horizontal-space ,*numeric-argument-p*)) +(global-set-key '(#\Space :meta) `(com-just-one-space ,*numeric-argument-marker*)) (global-set-key '(#\^ :shift :meta) 'com-delete-indentation) (global-set-key '(#\q :meta) 'com-fill-paragraph) (global-set-key '(#\d :meta) `(com-kill-word ,*numeric-argument-marker*))