[climacs-cvs] CVS update: climacs/packages.lisp climacs/lisp-syntax.lisp climacs/kill-ring.lisp climacs/gui.lisp
Dave Murray
dmurray at common-lisp.net
Sun Aug 14 18:09:43 UTC 2005
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*))
More information about the Climacs-cvs
mailing list