caml-types:
- largest typed region is now dynamically recomputed. - changed binding to C-down-mouse-1 (allow other bindings). - allow scrolling when mouse is moved to bottom or top of window. - ignore key events, out of frame-motion, and wait for mouse release. git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@5875 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
Didier Rémy
parent
60b74b3c3c
commit
7cbb6ca64b
|
|
@ -5,10 +5,25 @@
|
|||
|
||||
(defalias 'caml-line-beginning-position 'line-beginning-position)
|
||||
|
||||
(defalias 'caml-read-event 'read-event)
|
||||
(defalias 'caml-window-edges 'window-edges)
|
||||
(defun caml-mouse-vertical-position ()
|
||||
(cddr (mouse-position)))
|
||||
(defalias 'caml-ignore-event-p 'integer-or-marker-p)
|
||||
(defalias 'caml-mouse-movement-p 'mouse-movement-p)
|
||||
(defalias 'caml-sit-for 'sit-for)
|
||||
|
||||
(defmacro caml-track-mouse (&rest body) (cons 'track-mouse body))
|
||||
|
||||
(defun caml-event-window (e) (posn-window (event-start e)))
|
||||
(defun caml-event-point-start (e) (posn-point (event-start e)))
|
||||
(defun caml-event-point-end (e) (posn-point (event-end e)))
|
||||
(defalias 'caml-read-event 'read-event)
|
||||
(defmacro caml-track-mouse (&rest body) (cons 'track-mouse body))
|
||||
|
||||
(defun caml-release-event-p (original event)
|
||||
(and (equal (event-basic-type original) (event-basic-type event))
|
||||
(let ((modifiers (event-modifiers event)))
|
||||
(or (member 'drag modifiers)
|
||||
(member 'click modifiers)))))
|
||||
|
||||
|
||||
(provide 'caml-emacs)
|
||||
|
|
|
|||
|
|
@ -153,7 +153,7 @@ See `caml-types-location-re' for annotation file format.
|
|||
(not (window-live-p (get-buffer-window caml-types-buffer))))
|
||||
(display-buffer caml-types-buffer))
|
||||
(unwind-protect
|
||||
(sit-for 60)
|
||||
(caml-sit-for 60)
|
||||
(delete-overlay caml-types-expr-ovl)
|
||||
)))
|
||||
|
||||
|
|
@ -388,11 +388,23 @@ See `caml-types-location-re' for annotation file format.
|
|||
(interactive "e")
|
||||
nil)
|
||||
|
||||
(defun caml-types-time ()
|
||||
(let ((time (current-time)))
|
||||
(+ (* (mod (cadr time) 1000) 1000)
|
||||
(/ (cadr (cdr time)) 1000))))
|
||||
|
||||
(defun caml-types-explore (event)
|
||||
"Explore type annotations by mouse dragging.
|
||||
|
||||
The expression under the mouse is highlighted
|
||||
and its type is displayed in the minibuffer, until the move is released."
|
||||
The expression under the mouse is highlighted and its type is displayed
|
||||
in the minibuffer, until the move is released, much as `caml-types-show-type'.
|
||||
The function uses two overlays.
|
||||
|
||||
. One overlay delimits the largest region whose all subnodes
|
||||
are well-typed.
|
||||
. Another overlay delimits the current node under the mouse (whose type
|
||||
annotation is beeing displayed).
|
||||
"
|
||||
(interactive "e")
|
||||
(set-buffer (window-buffer (caml-event-window event)))
|
||||
(let* ((target-buf (current-buffer))
|
||||
|
|
@ -403,8 +415,13 @@ and its type is displayed in the minibuffer, until the move is released."
|
|||
target-pos
|
||||
Left Right limits cnum node mes type
|
||||
region
|
||||
(window (caml-event-window event))
|
||||
target-tree
|
||||
(speed 100)
|
||||
(last-time (caml-types-time))
|
||||
(original-event event)
|
||||
)
|
||||
(select-window window)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(caml-types-preprocess type-file)
|
||||
|
|
@ -415,66 +432,111 @@ and its type is displayed in the minibuffer, until the move is released."
|
|||
;; (message "Drag the mouse to explore types")
|
||||
(unwind-protect
|
||||
(caml-track-mouse
|
||||
(setq region
|
||||
(caml-types-typed-make-overlay
|
||||
target-buf (caml-event-point-start event)))
|
||||
(while (and event
|
||||
(integer-or-marker-p
|
||||
(setq cnum (caml-event-point-end event))))
|
||||
(if (and region (<= (car region) cnum) (< cnum (cdr region)))
|
||||
(if (and limits
|
||||
(>= cnum (car limits)) (< cnum (cdr limits)))
|
||||
(message mes)
|
||||
(setq target-bol
|
||||
(save-excursion
|
||||
(goto-char cnum) (caml-line-beginning-position))
|
||||
target-line (1+ (count-lines (point-min)
|
||||
target-bol))
|
||||
target-pos
|
||||
(vector target-file target-line target-bol cnum))
|
||||
(save-excursion
|
||||
(setq node (caml-types-find-location
|
||||
target-pos () target-tree))
|
||||
(set-buffer caml-types-buffer)
|
||||
(erase-buffer)
|
||||
(cond
|
||||
(node
|
||||
(setq Left
|
||||
(caml-types-get-pos target-buf (elt node 0))
|
||||
Right
|
||||
(caml-types-get-pos target-buf (elt node 1)))
|
||||
(move-overlay
|
||||
caml-types-expr-ovl Left Right target-buf)
|
||||
(setq limits
|
||||
(caml-types-find-interval target-buf
|
||||
target-pos node)
|
||||
type (elt node 2))
|
||||
)
|
||||
(t
|
||||
(delete-overlay caml-types-expr-ovl)
|
||||
(setq type "*no type information*")
|
||||
(setq limits
|
||||
(caml-types-find-interval
|
||||
target-buf target-pos target-tree))
|
||||
))
|
||||
(message (setq mes (format "type: %s" type)))
|
||||
(insert type)
|
||||
)))
|
||||
(setq event (caml-read-event))
|
||||
(unless (mouse-movement-p event) (setq event nil))
|
||||
(while event
|
||||
(message nil)
|
||||
(message "%S" event)
|
||||
(cond
|
||||
;; In emacs eliminate
|
||||
((caml-ignore-event-p event))
|
||||
((caml-release-event-p original-event event)
|
||||
(setq event nil))
|
||||
((and (caml-mouse-movement-p event)
|
||||
(not (and (equal window (caml-event-window event))
|
||||
(integer-or-marker-p
|
||||
(caml-event-point-end event)))))
|
||||
(let* ((win (caml-window-edges window))
|
||||
(top (nth 1 win))
|
||||
(bottom (- (nth 3 win) 1))
|
||||
mouse
|
||||
time
|
||||
)
|
||||
(while (and
|
||||
(caml-sit-for 0 (/ 500 speed))
|
||||
(setq time (caml-types-time))
|
||||
(> (- time last-time) (/ 500 speed))
|
||||
(setq mouse (caml-mouse-vertical-position))
|
||||
(or (< mouse top) (>= mouse bottom))
|
||||
)
|
||||
(setq last-time time)
|
||||
(cond
|
||||
((< mouse top)
|
||||
(setq speed (- top mouse))
|
||||
(condition-case nil
|
||||
(scroll-down 1)
|
||||
(error (message "Beginning of buffer!"))))
|
||||
((>= mouse bottom)
|
||||
(setq speed (+ 1 (- mouse bottom)))
|
||||
(condition-case nil
|
||||
(scroll-up 1)
|
||||
(error (message "End of buffer!"))))
|
||||
)
|
||||
(setq speed (* speed speed))
|
||||
)))
|
||||
((or (caml-mouse-movement-p event)
|
||||
(equal original-event event))
|
||||
(setq cnum (caml-event-point-end event))
|
||||
(if (and region
|
||||
(<= (car region) cnum) (< cnum (cdr region)))
|
||||
nil
|
||||
(setq region
|
||||
(caml-types-typed-make-overlay
|
||||
target-buf (caml-event-point-start event))))
|
||||
(if (and limits
|
||||
(>= cnum (car limits)) (< cnum (cdr limits)))
|
||||
(message mes)
|
||||
(setq target-bol
|
||||
(save-excursion
|
||||
(goto-char cnum) (caml-line-beginning-position))
|
||||
target-line (1+ (count-lines (point-min)
|
||||
target-bol))
|
||||
target-pos
|
||||
(vector target-file target-line target-bol cnum))
|
||||
(save-excursion
|
||||
(setq node (caml-types-find-location
|
||||
target-pos () target-tree))
|
||||
(set-buffer caml-types-buffer)
|
||||
(erase-buffer)
|
||||
(cond
|
||||
(node
|
||||
(setq Left
|
||||
(caml-types-get-pos target-buf (elt node 0))
|
||||
Right
|
||||
(caml-types-get-pos target-buf (elt node 1)))
|
||||
(move-overlay
|
||||
caml-types-expr-ovl Left Right target-buf)
|
||||
(setq limits
|
||||
(caml-types-find-interval target-buf
|
||||
target-pos node)
|
||||
type (elt node 2))
|
||||
)
|
||||
(t
|
||||
(delete-overlay caml-types-expr-ovl)
|
||||
(setq type "*no type information*")
|
||||
(setq limits
|
||||
(caml-types-find-interval
|
||||
target-buf target-pos target-tree))
|
||||
))
|
||||
;; (message (setq mes (format "type: %s" type)))
|
||||
(insert type)
|
||||
))
|
||||
)
|
||||
)
|
||||
(if event (setq event (caml-read-event)))
|
||||
)
|
||||
)
|
||||
(delete-overlay caml-types-expr-ovl)
|
||||
(delete-overlay caml-types-typed-ovl)
|
||||
))
|
||||
;; the mouse is down. One should prevent against mouse release,
|
||||
;; which could do something undesirable.
|
||||
;; In most common cases, next event will be mouse release.
|
||||
;; When an error occurs, the mouse release event has not been read.
|
||||
;; We could wait for mouse release to prevent execution of
|
||||
;; a binding of mouse release, such as cut or paste.
|
||||
;; In most common cases, next event will be the mouse release.
|
||||
;; However, it could also be a key stroke before mouse release.
|
||||
;; Will then execute the action for mouse release (if bound).
|
||||
;; Emacs does not allow to test whether mouse is up or down.
|
||||
;; Same problem may happen above while exploring
|
||||
(if (and event (caml-read-event)))
|
||||
;; Not sure it is robust to loop for mouse release after an error
|
||||
;; occured, as is done for exploration.
|
||||
;; So far, we just ignore next event. (Next line also be uncommenting.)
|
||||
(if event (caml-read-event))
|
||||
)))
|
||||
|
||||
(defun caml-types-typed-make-overlay (target-buf pos)
|
||||
|
|
|
|||
|
|
@ -9,12 +9,31 @@
|
|||
(defun caml-line-beginning-position ()
|
||||
(save-excursion (beginning-of-line) (point)))
|
||||
|
||||
(defun caml-event-window (e) (event-window e))
|
||||
(defalias 'caml-read-event 'next-event)
|
||||
(defalias 'caml-window-edges 'window-pixel-edges)
|
||||
(defun caml-mouse-vertical-position ()
|
||||
(let ((e (mouse-position-as-motion-event)))
|
||||
(and e (event-y-pixel e))))
|
||||
(defalias 'caml-mouse-movement-p 'motion-event-p)
|
||||
(defun caml-event-window (e)
|
||||
(and (mouse-event-p e) (event-window e)))
|
||||
(defun caml-event-point-start (e) (event-closest-point e))
|
||||
(defun caml-event-point-end (e) (event-closest-point e))
|
||||
(defalias 'caml-read-event 'next-event)
|
||||
(defun caml-ignore-event-p (e)
|
||||
(if (and (key-press-event-p e) (equal (key-binding e) 'keyboard-quit))
|
||||
(keyboard-quit))
|
||||
(not (mouse-event-p e)))
|
||||
|
||||
|
||||
(defun caml-sit-for (sec &optional mili)
|
||||
(sit-for (+ sec (if mili (* 0.001 mili)))))
|
||||
|
||||
|
||||
|
||||
(defmacro caml-track-mouse (&rest body) (cons 'progn body))
|
||||
|
||||
(defun mouse-movement-p (e) (equal (event-type e) 'motion))
|
||||
(defun caml-release-event-p (original event)
|
||||
(and (button-release-event-p event)
|
||||
(equal (event-button original) (event-button event))))
|
||||
|
||||
(provide 'caml-xemacs)
|
||||
|
|
|
|||
|
|
@ -283,9 +283,8 @@ have caml-electric-indent on, which see.")
|
|||
|
||||
;; caml-types
|
||||
(define-key caml-mode-map [?\C-c?\C-t] 'caml-types-show-type)
|
||||
;; to prevent misbehavior in case of error during exploration.
|
||||
(define-key caml-mode-map [mouse-2] 'caml-types-mouse-ignore)
|
||||
(define-key caml-mode-map [down-mouse-2] 'caml-types-explore)
|
||||
;; must be a mouse-down event. Can be any button and any prefix
|
||||
(define-key caml-mode-map [?\C-c down-mouse-1] 'caml-types-explore)
|
||||
;; caml-help
|
||||
(define-key caml-mode-map [?\C-c?i] 'ocaml-add-path)
|
||||
(define-key caml-mode-map [?\C-c?]] 'ocaml-close-module)
|
||||
|
|
|
|||
Loading…
Reference in New Issue