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

Modified Files: gui.lisp Log Message: Added new commands.

com-delete-horizontal-space (M-), com-scroll-other-window (M-C-v), com-kill-sentence (M-k), com-backward-kill-sentence (C-x Backspace), com-mark-page (C-x C-p).

Date: Mon Aug 8 16:48:22 2005 Author: dmurray

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.172 climacs/gui.lisp:1.173 --- climacs/gui.lisp:1.172 Mon Aug 8 14:15:05 2005 +++ climacs/gui.lisp Mon Aug 8 16:48:21 2005 @@ -764,6 +764,20 @@ while (whitespacep (object-after point)) do (incf (offset point)))))

+(define-named-command com-delete-horizontal-space ((backward-only-p + 'boolean :prompt "Delete backwards only?")) + (let* ((point (point (current-window))) + (mark (clone-mark point))) + (loop until (beginning-of-line-p point) + while (whitespacep (object-before point)) + do (backward-object point)) + (unless backward-only-p + (loop until (end-of-line-p mark) + while (whitespacep (object-after mark)) + do (forward-object mark))) + (delete-region point mark))) + + (define-named-command com-goto-position () (setf (offset (point (current-window))) (handler-case (accept 'integer :prompt "Goto Position") @@ -909,7 +923,11 @@ (cadr (windows *application-frame*))) (com-delete-window)) (setf *standard-output* (car (windows *application-frame*)))) - + +(define-named-command com-scroll-other-window () + (let ((other-window (second (windows *application-frame*)))) + (when other-window + (page-down other-window))))

(define-named-command com-delete-window () (unless (null (cdr (windows *application-frame*))) @@ -1277,6 +1295,28 @@ (loop repeat count do (forward-sentence point syntax)) (loop repeat (- count) do (backward-sentence point syntax)))))

+(define-named-command com-kill-sentence ((count 'integer :prompt "Number of sentences")) + (let* ((pane (current-window)) + (point (point pane)) + (mark (clone-mark point)) + (syntax (syntax (buffer pane)))) + (if (plusp count) + (loop repeat count do (forward-sentence point syntax)) + (loop repeat (- count) do (backward-sentence point syntax))) + (kill-ring-standard-push *kill-ring* (region-to-sequence point mark)) + (delete-region point mark)))) + +(define-named-command com-backward-kill-sentence ((count 'integer :prompt "Number of sentences")) + (let* ((pane (current-window)) + (point (point pane)) + (mark (clone-mark point)) + (syntax (syntax (buffer pane)))) + (if (plusp count) + (loop repeat count do (backward-sentence point syntax)) + (loop repeat (- count) do (forward-sentence point syntax))) + (kill-ring-standard-push *kill-ring* (region-to-sequence point mark)) + (delete-region point mark))) + (defun forward-page (mark &optional (count 1)) (loop repeat count unless (search-forward mark (coerce (list #\Newline #\Page) 'vector)) @@ -1304,6 +1344,19 @@ (backward-page point count) (forward-page point count))))

+(define-named-command com-mark-page ((count 'integer :prompt "Move how many pages") + (numargp 'boolean :prompt "Move to another page?")) + (let* ((pane (current-window)) + (point (point pane)) + (mark (mark pane))) + (cond ((and numargp (/= 0 count)) + (if (plusp count) + (forward-page point count) + (backward-page point (1+ count)))) + (t (backward-page point count))) + (setf (offset mark) (offset point)) + (forward-page mark 1))) + (define-named-command com-count-lines-page () (let* ((pane (current-window)) (point (point pane)) @@ -1507,6 +1560,7 @@ (global-set-key '(#\w :control) 'com-kill-region) (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*)) (global-set-key '(#@ :meta :control :shift) `(com-mark-expression ,*numeric-argument-marker*)) (global-set-key '(#\f :meta) `(com-forward-word ,*numeric-argument-marker*)) (global-set-key '(#\b :meta) `(com-backward-word ,*numeric-argument-marker*)) @@ -1519,9 +1573,11 @@ (global-set-key '(#\w :meta) 'com-copy-region) (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 '(#< :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 '(#^ :shift :meta) 'com-delete-indentation) (global-set-key '(#\q :meta) 'com-fill-paragraph) (global-set-key '(#\d :meta) `(com-kill-word ,*numeric-argument-marker*)) @@ -1590,12 +1646,14 @@ (c-x-set-key '(#\u) 'com-undo) (c-x-set-key '(#]) `(com-forward-page ,*numeric-argument-marker*)) (c-x-set-key '(#[) `(com-backward-page ,*numeric-argument-marker*)) +(c-x-set-key '(#\p :control) `(com-mark-page ,*numeric-argument-marker* ,*numeric-argument-p*)) (c-x-set-key '(#\l) 'com-count-lines-page) (c-x-set-key '(#\s :control) 'com-save-buffer) (c-x-set-key '(#\t :control) 'com-transpose-lines) (c-x-set-key '(#\w :control) 'com-write-buffer) (c-x-set-key '(#\x :control) 'com-exchange-point-and-mark) (c-x-set-key '(#=) 'com-what-cursor-position) +(c-x-set-key '(#\Backspace) `(com-backward-kill-sentence ,*numeric-argument-marker*))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;