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

[Dave Murray]

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

Modified Files:
	gui.lisp 
Log Message:
Added com-count-lines-region (M-=) and com-what-cursor-position (C-x =).
(Also altered com-browse-url to actually run on my iBook.)

Date: Mon Aug  8 14:15:06 2005
Author: dmurray

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.171 climacs/gui.lisp:1.172
--- climacs/gui.lisp:1.171	Sat Aug  6 22:51:19 2005
+++ climacs/gui.lisp	Mon Aug  8 14:15:05 2005
@@ -790,7 +790,9 @@
 		      (offset mark))))
 
 (define-named-command com-browse-url ()
-  (accept 'url :prompt "Browse URL"))
+  (let ((url (accept 'url :prompt "Browse URL")))
+    #+ (and sbcl darwin)
+    (sb-ext:run-program "/usr/bin/open" `(,url) :wait nil))))
 
 (define-named-command com-set-mark ()
   (let ((pane (current-window)))
@@ -1314,6 +1316,26 @@
 	  (after (number-of-lines-in-region point end)))
       (display-message "Page has ~A lines (~A + ~A)" total before after))))
 
+(define-named-command com-count-lines-region ()
+  (let*  ((pane (current-window))
+	  (point (point pane))
+	  (mark (mark pane))
+	  (lines (number-of-lines-in-region point mark))
+	  (chars (abs (- (offset point) (offset mark)))))
+    (display-message "Region has ~D line~:P, ~D character~:P." lines chars)))
+
+(define-named-command com-what-cursor-position ()
+  (let* ((pane (current-window))
+	 (point (point pane))
+	 (buffer (buffer pane))
+	 (offset (offset point))
+	 (size (size buffer))
+	 (char (object-after point))
+	 (column (column-number point)))
+    (display-message "Char: ~:C (#o~O ~:*~D ~:*#x~X) point=~D of ~D (~D%) column ~D"
+		     char (char-code char) offset size
+		     (round (* 100 (/ offset size))) column)))
+
 (define-named-command com-eval-expression ((insertp 'boolean :prompt "Insert?"))
   (let* ((*package* (find-package :climacs-gui))
 	 (string (handler-case (accept 'string :prompt "Eval")
@@ -1432,7 +1454,7 @@
 
 (define-named-command com-accept-string ()
   (display-message (format nil "~s" (accept 'string))))
-	 
+ 
 (define-named-command com-accept-symbol ()
   (display-message (format nil "~s" (accept 'symbol))))	 
 
@@ -1514,7 +1536,7 @@
 (global-set-key '(#\_ :shift :meta) 'com-redo)
 (global-set-key '(#\_ :shift :control) 'com-undo)
 (global-set-key '(#\% :shift :meta) 'com-query-replace)
-
+(global-set-key '(#\= :meta) 'com-count-lines-region)
 (global-set-key '(:up) `(com-previous-line ,*numeric-argument-marker*))
 (global-set-key '(:down) `(com-next-line ,*numeric-argument-marker*))
 (global-set-key '(:left) `(com-backward-object ,*numeric-argument-marker*))
@@ -1573,6 +1595,7 @@
 (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)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;