[climacs-cvs] CVS update: climacs/gui.lisp climacs/lisp-syntax.lisp climacs/packages.lisp climacs/syntax.lisp

[Robert Strandh]

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

Modified Files:
	gui.lisp lisp-syntax.lisp packages.lisp syntax.lisp 
Log Message:
Implemented comment-region and uncomment region as syntax-dependent
generic functions.  

Need to figure out how a command that is not invoked by keystrokes can
determine whether it was called with a numeric argument. 


Date: Thu Aug  4 03:10:49 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.168 climacs/gui.lisp:1.169
--- climacs/gui.lisp:1.168	Mon Aug  1 23:53:38 2005
+++ climacs/gui.lisp	Thu Aug  4 03:10:45 2005
@@ -1207,6 +1207,18 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
+;;; Commenting
+
+;;; figure out how to make commands without key bindings accept numeric arguments. 
+(define-named-command com-comment-region ()
+  (let* ((pane (current-window))
+	 (point (point pane))
+	 (mark (mark pane))
+	 (syntax (syntax (buffer pane))))
+    (comment-region syntax point mark)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 
 ;;; For testing purposes
 
 (define-named-command com-reset-profile ()


Index: climacs/lisp-syntax.lisp
diff -u climacs/lisp-syntax.lisp:1.18 climacs/lisp-syntax.lisp:1.19
--- climacs/lisp-syntax.lisp:1.18	Thu Jul 28 22:36:36 2005
+++ climacs/lisp-syntax.lisp	Thu Aug  4 03:10:45 2005
@@ -1676,3 +1676,17 @@
 	(setf (offset mark) (start-offset tree))
 	(+ (real-column-number mark tab-width)
 	   offset)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Commenting
+
+(defmethod syntax-line-comment-string ((syntax lisp-syntax))
+  ";;; ")
+
+(defmethod comment-region ((syntax lisp-syntax) mark1 mark2)
+  (line-comment-region syntax mark1 mark2))
+
+(defmethod uncomment-region ((syntax lisp-syntax) mark1 mark2)
+  (line-uncomment-region syntax mark1 mark2))
+


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.71 climacs/packages.lisp:1.72
--- climacs/packages.lisp:1.71	Thu Jul 28 22:36:36 2005
+++ climacs/packages.lisp	Thu Aug  4 03:10:45 2005
@@ -108,7 +108,10 @@
 	   #:forward-expression #:backward-expression
 	   #:eval-defun
 	   #:redisplay-pane-with-syntax
-	   #:beginning-of-paragraph #:end-of-paragraph))
+	   #:beginning-of-paragraph #:end-of-paragraph
+	   #:syntax-line-comment-string
+	   #:line-comment-region #:comment-region
+	   #:line-uncomment-region #:uncomment-region))
 
 (defpackage :climacs-kill-ring
   (:use :clim-lisp :flexichain)


Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.53 climacs/syntax.lisp:1.54
--- climacs/syntax.lisp:1.53	Mon Jul  4 15:55:56 2005
+++ climacs/syntax.lisp	Thu Aug  4 03:10:45 2005
@@ -57,6 +57,60 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
+;;; Commenting
+
+(defgeneric syntax-line-comment-string (syntax)
+  (:documentation "string to use at the beginning of a line to 
+indicate a line comment"))
+
+(defgeneric line-comment-region (syntax mark1 mark2)
+  (:documentation "inset a line comment string at the beginning of 
+every line in the region"))
+
+(defmethod line-comment-region (syntax mark1 mark2)
+  (when (mark< mark2 mark1)
+    (rotatef mark1 mark2))
+  (let ((mark (clone-mark mark1)))
+    (unless (beginning-of-line-p mark)
+      (end-of-line mark)
+      (unless (end-of-buffer-p mark)
+	(forward-object mark)))
+    (loop while (mark< mark mark2)
+	  do (insert-sequence mark (syntax-line-comment-string syntax))
+	     (end-of-line mark)
+	     (unless (end-of-buffer-p mark)
+	       (forward-object mark)))))	  
+
+(defgeneric line-uncomment-region (syntax mark1 mark2)
+  (:documentation "inset a line comment string at the beginning of 
+every line in the region"))
+
+(defmethod line-uncomment-region (syntax mark1 mark2)
+  (when (mark< mark2 mark1)
+    (rotatef mark1 mark2))
+  (let ((mark (clone-mark mark1)))
+    (unless (beginning-of-line-p mark)
+      (end-of-line mark)
+      (unless (end-of-buffer-p mark)
+	(forward-object mark)))
+    (loop while (mark< mark mark2)
+	  do (when (looking-at mark (syntax-line-comment-string syntax))
+	       (delete-range mark (length (syntax-line-comment-string syntax))))
+	     (end-of-line mark)
+	     (unless (end-of-buffer-p mark)
+	       (forward-object mark)))))
+
+(defgeneric comment-region (syntax mark1 mark2)
+  (:documentation "turn the region between the two marks into a comment
+in the specific syntax.")
+  (:method (syntax mark1 mark2) nil))
+
+(defgeneric uncomment-region (syntax mark1 mark2)
+  (:documentation "remove comment around region")
+  (:method (syntax mark1 mark2) nil))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
 ;;; Syntax completion
 
 (defparameter *syntaxes* '())