[climacs-cvs] CVS climacs

[thenriksen]

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 , at 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)))
+              , at 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