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

Modified Files: base.lisp gui.lisp packages.lisp Log Message: New commands:

M-m (back to indentation) M-d (delete word) M-backspace (backward delete word) M-x goto-position M-x goto-line

New function whitespacep.

Used `:name t' instead of repeating the command name in define-command.

Date: Wed Dec 29 17:03:22 2004 Author: rstrandh

Index: climacs/base.lisp diff -u climacs/base.lisp:1.6 climacs/base.lisp:1.7 --- climacs/base.lisp:1.6 Mon Dec 27 12:32:46 2004 +++ climacs/base.lisp Wed Dec 29 17:03:21 2004 @@ -93,6 +93,12 @@ #+sbcl (sb-impl::constituentp obj) #-sbcl (alphanumericp obj)))

+(defun whitespacep (obj) + "A predicate to ensure that an object is a whitespace character." + (and (characterp obj) + #+sbcl (sb-impl::whitespacep obj) + #-sbcl (member obj '(#\Space #\Tab)))) + (defun forward-word (mark) "Forward the mark to the next word." (loop until (end-of-buffer-p mark) @@ -110,4 +116,22 @@ (loop until (beginning-of-buffer-p mark) while (constituentp (object-before mark)) do (decf (offset mark)))) + +(defun delete-word (mark) + "Delete until the end of the word" + (loop until (end-of-buffer-p mark) + until (constituentp (object-after mark)) + do (incf (offset mark))) + (loop until (end-of-buffer-p mark) + while (constituentp (object-after mark)) + do (delete-range mark))) + +(defun backward-delete-word (mark) + "Delete until the beginning of the word" + (loop until (beginning-of-buffer-p mark) + until (constituentp (object-before mark)) + do (decf (offset mark))) + (loop until (beginning-of-buffer-p mark) + while (constituentp (object-before mark)) + do (delete-range mark -1)))

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.31 climacs/gui.lisp:1.32 --- climacs/gui.lisp:1.31 Wed Dec 29 09:02:45 2004 +++ climacs/gui.lisp Wed Dec 29 17:03:21 2004 @@ -157,7 +157,7 @@ (setf (needs-saving buffer) t))) (redisplay-frame-panes frame))))

-(define-command (com-quit :name "Quit" :command-table climacs) () +(define-command (com-quit :name t :command-table climacs) () (frame-exit *application-frame*))

(define-command com-self-insert () @@ -201,6 +201,12 @@ (define-command com-backward-word () (backward-word (point (win *application-frame*))))

+(define-command com-delete-word () + (delete-word (point (win *application-frame*)))) + +(define-command com-backward-delete-word () + (backward-delete-word (point (win *application-frame*)))) + (define-command com-toggle-layout () (setf (frame-current-layout *application-frame*) (if (eq (frame-current-layout *application-frame*) 'default) @@ -290,7 +296,7 @@ (concatenate 'string (pathname-name pathname) "." (pathname-type pathname))))

-(define-command (com-find-file :name "Find File" :command-table climacs) () +(define-command (com-find-file :name t :command-table climacs) () (let ((filename (accept 'completable-pathname :prompt "Find File"))) (with-slots (buffer point syntax) (win *application-frame*) @@ -339,6 +345,29 @@ (define-command com-end-of-buffer () (end-of-buffer (point (win *application-frame*))))

+(define-command com-back-to-indentation () + (let ((point (point (win *application-frame*)))) + (beginning-of-line point) + (loop until (end-of-line-p point) + while (whitespacep (object-after point)) + do (incf (offset point))))) + +(define-command (com-goto-position :name t :command-table climacs) () + (setf (offset (point (win *application-frame*))) + (accept 'integer :prompt "Goto Position"))) + +(define-command (com-goto-line :name t :command-table climacs) () + (loop with mark = (make-instance 'standard-right-sticky-mark + :buffer (buffer (win *application-frame*))) + do (end-of-line mark) + until (end-of-buffer-p mark) + repeat (accept 'integer :prompt "Goto Line") + do (incf (offset mark)) + (end-of-line mark) + finally (beginning-of-line mark) + (setf (offset (point (win *application-frame*))) + (offset mark)))) + (define-command com-browse-url () (accept 'url :prompt "Browse URL"))

@@ -424,6 +453,9 @@ (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) +(global-set-key '(#\m :meta) 'com-back-to-indentation) +(global-set-key '(#\d :meta) 'com-delete-word) +(global-set-key '(#\Backspace :meta) 'com-backward-delete-word)

(global-set-key '(:up) 'com-previous-line) (global-set-key '(:down) 'com-next-line)

Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.14 climacs/packages.lisp:1.15 --- climacs/packages.lisp:1.14 Wed Dec 29 08:06:46 2004 +++ climacs/packages.lisp Wed Dec 29 17:03:21 2004 @@ -45,8 +45,9 @@ (:export #:previous-line #:next-line #:open-line #:kill-line #:number-of-lines-in-region - #:constituentp + #:constituentp #:whitespacep #:forward-word #:backward-word + #:delete-word #:backward-delete-word #:input-from-stream #:output-to-stream))

(defpackage :climacs-abbrev