[Openmcl-cvs-notifications] r11971 - in /trunk/source/cocoa-ide: cocoa-editor.lisp hemlock/src/bindings.lisp hemlock/src/command.lisp

[gb at clozure.com]

Author: gb
Date: Mon Apr 27 01:54:44 2009
New Revision: 11971

Log:
HEMLOCK-EXT:SCROLL-VIEW: accept HOW arguments (:VIEW-PAGE-UP/DOWN) that
don't modify the selection.

New "Page Up", "Page Down" commands.

Bind #k"pageup" to "Page Up", #k"pagedown" to "Page Down" commands.

(ticket:195).

Modified:
    trunk/source/cocoa-ide/cocoa-editor.lisp
    trunk/source/cocoa-ide/hemlock/src/bindings.lisp
    trunk/source/cocoa-ide/hemlock/src/command.lisp

Modified: trunk/source/cocoa-ide/cocoa-editor.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/cocoa-editor.lisp (original)
+++ trunk/source/cocoa-ide/cocoa-editor.lisp Mon Apr 27 01:54:44 2009
@@ -2764,7 +2764,8 @@
 =

 (defmethod hemlock-ext:scroll-view ((view hi:hemlock-view) how &optional w=
here)
   (assume-cocoa-thread)
-  (let* ((tv (text-pane-text-view (hi::hemlock-view-pane view))))
+  (let* ((tv (text-pane-text-view (hi::hemlock-view-pane view)))
+         (may-change-selection t))
     (when (eq how :line)
       (setq where (require-type where '(integer 0)))
       (let* ((line-y (nth-value 1 (charpos-xy tv where)))
@@ -2774,11 +2775,15 @@
     (ecase how
       (:center-selection
        (#/centerSelectionInVisibleArea: tv +null-ptr+))
-      (:page-up
+      ((:page-up :view-page-up)
+       (when (eq how :view-page-up)
+         (setq may-change-selection nil))
        (require-type where 'null)
        ;; TODO: next-screen-context-lines
        (scroll-by-lines tv (- *next-screen-context-lines* (view-screen-lin=
es view))))
-      (:page-down
+      ((:page-down :view-page-down)
+       (when (eq how :view-page-down)
+         (setq may-change-selection nil))
        (require-type where 'null)
        (scroll-by-lines tv (- (view-screen-lines view) *next-screen-contex=
t-lines*)))
       (:lines-up
@@ -2786,14 +2791,15 @@
       (:lines-down
        (scroll-by-lines tv (require-type where 'integer))))
     ;; If point is not on screen, move it.
-    (let* ((point (hi::current-point))
-           (point-pos (hi::mark-absolute-position point)))
-      (multiple-value-bind (win-pos win-len) (visible-charpos-range tv)
-        (unless (and (<=3D win-pos point-pos) (< point-pos (+ win-pos win-=
len)))
-          (let* ((point (hi::current-point-collapsing-selection))
-                 (cache (hemlock-buffer-string-cache (#/hemlockString (#/t=
extStorage tv)))))
-            (move-hemlock-mark-to-absolute-position point cache win-pos)
-            (update-hemlock-selection (#/textStorage tv))))))))
+    (when may-change-selection
+      (let* ((point (hi::current-point))
+             (point-pos (hi::mark-absolute-position point)))
+        (multiple-value-bind (win-pos win-len) (visible-charpos-range tv)
+          (unless (and (<=3D win-pos point-pos) (< point-pos (+ win-pos wi=
n-len)))
+            (let* ((point (hi::current-point-collapsing-selection))
+                   (cache (hemlock-buffer-string-cache (#/hemlockString (#=
/textStorage tv)))))
+              (move-hemlock-mark-to-absolute-position point cache win-pos)
+              (update-hemlock-selection (#/textStorage tv)))))))))
 =

 (defun iana-charset-name-of-nsstringencoding (ns)
   (#_CFStringConvertEncodingToIANACharSetName

Modified: trunk/source/cocoa-ide/hemlock/src/bindings.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/hemlock/src/bindings.lisp (original)
+++ trunk/source/cocoa-ide/hemlock/src/bindings.lisp Mon Apr 27 01:54:44 20=
09
@@ -69,9 +69,9 @@
 (bind-key "Transpose Characters" #k"control-t")
 (bind-key "Universal Argument" #k"control-u")
 (bind-key "Scroll Window Down" #k"control-v")
-(bind-key "Scroll Window Down" #k"pagedown")
+(bind-key "Page Down" #k"pagedown")
 (bind-key "Scroll Window Up" #k"meta-v")
-(bind-key "Scroll Window Up" #k"pageup")
+(bind-key "Page Up" #k"pageup")
 ;(bind-key "Scroll Next Window Down" #k"control-meta-v")
 ;(bind-key "Scroll Next Window Up" #k"control-meta-V")
 =


Modified: trunk/source/cocoa-ide/hemlock/src/command.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/hemlock/src/command.lisp (original)
+++ trunk/source/cocoa-ide/hemlock/src/command.lisp Mon Apr 27 01:54:44 2009
@@ -386,6 +386,12 @@
     (set-scroll-position :lines-down p)
     (set-scroll-position :page-down)))
 =

+(defcommand "Page Down" (p)
+  "Move down one screenfull, without changing the selection."
+  "Ignores prefix argument"
+  (declare (ignore p))
+  (set-scroll-position :view-page-down))
+
 (defcommand "Scroll Window Up" (p)
   "Move up one screenfull.
   With prefix argument scroll up that many lines."
@@ -395,6 +401,12 @@
   (if p
     (set-scroll-position :lines-up p)
     (set-scroll-position :page-up)))
+
+(defcommand "Page Up" (p)
+  "Move up one screenfull, without changing the selection."
+  "Ignores prefix argument."
+  (declare (ignore p))
+  (set-scroll-position :view-page-up))
 =

 ;;;; Kind of miscellaneous commands:
 =