Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv14986
Modified Files: packages.lisp misc-commands.lisp lisp-syntax-commands.lisp base.lisp Log Message: Added region- and expression-indentation commands.
--- /project/climacs/cvsroot/climacs/packages.lisp 2006/03/25 21:15:21 1.86 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/03/26 14:14:48 1.87 @@ -57,6 +57,7 @@ (defpackage :climacs-base (:use :clim-lisp :climacs-buffer) (:export #:do-buffer-region + #:do-buffer-region-lines #:previous-line #:next-line #:open-line #:kill-line #:empty-line-p @@ -73,6 +74,7 @@ #:upcase-word #:downcase-word #:capitalize-word #:tabify-region #:untabify-region #:indent-line + #:indent-region #:delete-indentation #:fill-line #:input-from-stream #:output-to-stream --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/03/03 19:38:57 1.4 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/03/26 14:14:48 1.5 @@ -531,6 +531,30 @@ 'indent-table '((#\j :control)))
+(defun indent-region (pane mark1 mark2) + "Indent all lines in the region delimited by `mark1' and `mark2' + according to the rules of the active syntax in `pane'." + (let* ((buffer (buffer pane)) + (view (stream-default-view pane)) + (tab-space-count (tab-space-count view)) + (tab-width (and (climacs-pane:indent-tabs-mode buffer) + tab-space-count)) + (syntax (climacs-syntax:syntax buffer))) + (do-buffer-region-lines (line mark1 mark2) + (let ((indentation (climacs-syntax:syntax-line-indentation + line + tab-space-count + syntax))) + (indent-line line indentation tab-width))))) + +(define-command (com-indent-region :name t :command-table indent-table) () + "Indent every line of the current region as specified by the +syntax for the buffer." + (let* ((pane (current-window)) + (point (point pane)) + (mark (mark pane))) + (indent-region pane point mark))) + (define-command (com-delete-indentation :name t :command-table indent-table) () (delete-indentation (point (current-window))))
--- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/03/15 17:17:48 1.3 +++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/03/26 14:14:48 1.4 @@ -32,25 +32,42 @@
(define-command (com-eval-defun :name t :command-table lisp-table) () (let* ((pane (current-window)) - (point (point pane)) - (syntax (syntax (buffer pane)))) + (point (point pane)) + (syntax (syntax (buffer pane)))) (eval-defun point syntax)))
(esa:set-key 'com-eval-defun - 'lisp-table - '((#\x :control :meta))) + 'lisp-table + '((#\x :control :meta)))
(define-command (com-package :name t :command-table lisp-table) () (let* ((pane (current-window)) - (syntax (syntax (buffer pane))) - (package (climacs-lisp-syntax::package-of syntax))) + (syntax (syntax (buffer pane))) + (package (climacs-lisp-syntax::package-of syntax))) (esa:display-message (format nil "~A" (if (packagep package) - (package-name package) - package))))) + (package-name package) + package)))))
(define-command (com-fill-paragraph :name t :command-table lisp-table) () )
(esa:set-key 'com-fill-paragraph - 'lisp-table - '((#\q :meta))) \ No newline at end of file + 'lisp-table + '((#\q :meta))) + +(define-command (com-indent-expression :name t :command-table lisp-table) + ((count 'integer :prompt "Number of expressions")) + (let* ((pane (current-window)) + (point (point pane)) + (mark (clone-mark point)) + (syntax (syntax (buffer pane))) + (view (stream-default-view pane)) + (tab-space-count (tab-space-count view))) + (if (plusp count) + (loop repeat count do (forward-expression mark syntax)) + (loop repeat (- count) do (backward-expression mark syntax))) + (indent-region pane (clone-mark point) mark))) + +(esa:set-key `(com-indent-expression ,*numeric-argument-marker*) + 'lisp-table + '((#\q :meta :control))) \ No newline at end of file --- /project/climacs/cvsroot/climacs/base.lisp 2005/08/27 22:07:45 1.45 +++ /project/climacs/cvsroot/climacs/base.lisp 2006/03/26 14:14:48 1.46 @@ -41,6 +41,27 @@ (loop for ,offset from ,offset1 below ,offset2 do ,@body)))
+(defmacro do-buffer-region-lines ((line-var mark1 mark2) &body body) + "Iterate over the lines in the region delimited by `mark1' and `mark2'. + For each line, `line-var' will be bound to a mark positioned + at the beginning of the line and `body' will be executed. Note + that the iteration will always start from the mark specifying + the earliest position in the buffer." + (let ((mark-sym (gensym)) + (mark2-sym (gensym))) + `(progn + (when (mark< ,mark2 ,mark1) + (rotatef ,mark1 ,mark2)) + (let ((,mark-sym (clone-mark ,mark1)) + (,mark2-sym (clone-mark ,mark2))) + (loop while (mark<= ,mark-sym ,mark2-sym) + do + (let ((,line-var (clone-mark ,mark-sym))) + ,@body) + (end-of-line ,mark-sym) + (unless (end-of-buffer-p ,mark-sym) + (forward-object ,mark-sym))))))) + (defmethod previous-line (mark &optional column (count 1)) "Move a mark up COUNT lines conserving horizontal position." (unless column