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

[Robert Strandh]

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

Modified Files:
	gui.lisp packages.lisp syntax.lisp 
Log Message:
Implemented page-down (M-v).

Date: Sat Jan  1 11:43:39 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.39 climacs/gui.lisp:1.40
--- climacs/gui.lisp:1.39	Sat Jan  1 11:06:21 2005
+++ climacs/gui.lisp	Sat Jan  1 11:43:39 2005
@@ -394,6 +394,10 @@
   (let ((pane (win *application-frame*)))
     (page-down pane (syntax pane))))
 
+(define-named-command com-page-up ()
+  (let ((pane (win *application-frame*)))
+    (page-up pane (syntax pane))))
+
 (define-named-command com-end-of-buffer ()
   (end-of-buffer (point (win *application-frame*))))
 
@@ -508,6 +512,7 @@
 (global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only
 (global-set-key '(#\w :meta) 'com-copy-out)
 (global-set-key '(#\v :control) 'com-page-down)
+(global-set-key '(#\v :meta) 'com-page-up)
 (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)


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.18 climacs/packages.lisp:1.19
--- climacs/packages.lisp:1.18	Sat Jan  1 11:06:21 2005
+++ climacs/packages.lisp	Sat Jan  1 11:43:39 2005
@@ -60,7 +60,7 @@
   (:use :clim-lisp :clim :climacs-buffer :climacs-base :flexichain)
   (:export #:syntax #:basic-syntax #:texinfo-syntax
 	   #:redisplay-pane #:redisplay-with-syntax #:full-redisplay
-	   #:page-down
+	   #:page-down #:page-up
 	   #:url))
 
 (defpackage :climacs-kill-ring


Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.15 climacs/syntax.lisp:1.16
--- climacs/syntax.lisp:1.15	Sat Jan  1 11:06:21 2005
+++ climacs/syntax.lisp	Sat Jan  1 11:43:39 2005
@@ -199,7 +199,6 @@
 	 (declare (ignore x y w))
 	 (let ((nb-lines-in-pane (max 1 (floor h (+ height (stream-vertical-spacing pane)))))
 	       (nb-lines-on-display (1+ (number-of-lines-in-region top bot))))
-	   (format *query-io* "~a ~a~%" (offset top) (offset bot))
 	   ;; adjust the region on display to fit the pane
 	   (loop repeat (- nb-lines-on-display nb-lines-in-pane)
 		 do (beginning-of-line bot)
@@ -235,6 +234,23 @@
        (beginning-of-line top)
        (setf (offset (point pane)) (offset top))
        (setf cache nil))))
+
+(defun page-up (pane syntax)
+  (position-window pane syntax)
+  (with-slots (top bot cache) syntax
+     (let ((nb-lines-in-region (number-of-lines-in-region top bot)))
+       (when (> (offset top) 0)
+	 (setf (offset bot) (offset top))
+	 (end-of-line bot)
+	 (loop repeat  nb-lines-in-region
+	       while (> (offset top) 0)
+	       do (decf (offset top))
+		  (beginning-of-line top))
+	 (setf (offset (point pane)) (offset top))
+	 (position-window pane syntax)
+	 (setf (offset (point pane)) (offset bot))
+	 (beginning-of-line (point pane))
+	 (setf cache nil)))))
 
 ;;; this one should not be necessary. 
 (defun round-up (x)