Index: foldout.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-packages/oa/edit-utils/foldout.el,v retrieving revision 1.1.1.1 diff -u -r1.1.1.1 foldout.el --- foldout.el 1998/01/14 06:36:15 1.1.1.1 +++ foldout.el 2000/04/03 05:18:44 @@ -5,7 +5,7 @@ ;; Author: Kevin Broadey ;; Created: 27 Jan 1994 ;; Version: foldout.el 1.10 dated 94/05/19 at 17:09:12 -;; Keywords: folding, outline +;; Keywords: folding, outlines ;; This file is part of XEmacs. @@ -24,7 +24,7 @@ ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Synched up with: FSF 19.34. +;;; Synched up with: FSF 20.6. ;;; Commentary: @@ -238,6 +238,15 @@ ;; slip our fold announcement into the list (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) )) + +;; outline-flag-region has different `flag' values in outline.el and +;; noutline.el for hiding and showing text. + +(defconst foldout-hide-flag + (if (featurep 'noutline) t ?\^M)) + +(defconst foldout-show-flag + (if (featurep 'noutline) nil ?\n)) (defun foldout-zoom-subtree (&optional exposure) @@ -360,12 +369,13 @@ (point-max)))) ;; hide the subtree (if hide-fold - (outline-flag-region start-marker end-of-subtree ?\^M)) + (outline-flag-region start-marker end-of-subtree + foldout-hide-flag)) ;; make sure the next heading is exposed (if end-marker - (outline-flag-region end-of-subtree - beginning-of-heading ?\n)) + (outline-flag-region end-of-subtree beginning-of-heading + foldout-show-flag)) )) ;; zap the markers so they don't slow down editing @@ -409,7 +419,8 @@ )))) -(defun foldout-mouse-zoom (event) +;; XEmacs change. +(defun foldout-mouse-zoom (event click-count) "Zoom in on the heading clicked on. How much is exposed by the zoom depends on the number of mouse clicks:- @@ -418,24 +429,23 @@ 2 expose subheadings 3 expose body and subheadings 4 expose entire subtree" - (interactive "@e") + (interactive "@e\np") ;; swallow intervening mouse events so we only get the final click-count. - (setq event (foldout-mouse-swallow-events event)) +;; (setq event (foldout-mouse-swallow-events event)) ;; go to the heading clicked on (foldout-mouse-goto-heading event) ;; zoom away (foldout-zoom-subtree - (let ((nclicks (event-click-count event))) - (cond - ((= nclicks 1) -1) ; body only - ((= nclicks 2) '(1)) ; subheadings only - ((= nclicks 3) nil) ; body and subheadings - (t 0))))) ; entire subtree + (cond + ((= click-count 1) -1) ; body only + ((= click-count 2) '(1)) ; subheadings only + ((= click-count 3) nil) ; body and subheadings + (t 0)))) ; entire subtree -(defun foldout-mouse-show (event) +(defun foldout-mouse-show (event click-count) "Show what is hidden under the heading clicked on. What gets exposed depends on the number of mouse clicks:- @@ -444,21 +454,20 @@ 2 expose subheadings 3 expose body and subheadings 4 expose entire subtree" - (interactive "@e") + (interactive "@e\np") ;; swallow intervening mouse events so we only get the final click-count. - (setq event (foldout-mouse-swallow-events event)) +;; (setq event (foldout-mouse-swallow-events event)) ;; expose the text (foldout-mouse-goto-heading event) - (let ((nclicks (event-click-count event))) - (cond - ((= nclicks 1) (show-entry)) - ((= nclicks 2) (show-children)) - ((= nclicks 3) (show-entry) (show-children)) - (t (show-subtree))))) + (cond + ((= click-count 1) (show-entry)) + ((= click-count 2) (show-children)) + ((= click-count 3) (show-entry) (show-children)) + (t (show-subtree)))) -(defun foldout-mouse-hide-or-exit (event) +(defun foldout-mouse-hide-or-exit (event click-count) "Hide the subtree under the heading clicked on, or exit a fold. What happens depends on the number of mouse clicks:- @@ -467,38 +476,39 @@ 2 exit fold and hide text 3 exit fold without hiding text 4 exit all folds and hide text" - (interactive "@e") + (interactive "@e\np") ;; swallow intervening mouse events so we only get the final click-count. - (setq event (foldout-mouse-swallow-events event)) +;; (setq event (foldout-mouse-swallow-events event)) ;; hide or exit - (let ((nclicks (event-click-count event))) - (if (= nclicks 1) - (progn - (foldout-mouse-goto-heading event) - (hide-subtree)) - (foldout-exit-fold - (cond - ((= nclicks 2) 1) ; exit and hide - ((= nclicks 3) -1) ; exit don't hide - (t 0)))))) ; exit all + (if (= click-count 1) + (progn + (foldout-mouse-goto-heading event) + (hide-subtree)) + (foldout-exit-fold + (cond + ((= click-count 2) 1) ; exit and hide + ((= click-count 3) -1) ; exit don't hide + (t 0))))) ; exit all -(defun foldout-mouse-swallow-events (event) - "Swallow intervening mouse events so we only get the final click-count. -Signal an error if the final event isn't the same type as the first one." - (let ((initial-event-type (event-basic-type event))) - (while (null (sit-for 0 double-click-time 'nodisplay)) - (setq event (read-event))) - (or (eq initial-event-type (event-basic-type event)) - (error ""))) - event) +;; XEmacs change. +;;(defun foldout-mouse-swallow-events (event) +;; "Swallow intervening mouse events so we only get the final click-count. +;;Signal an error if the final event isn't the same type as the first one." +;; (let ((initial-event-type (event-basic-type event))) +;; (while (null (sit-for 0 double-click-time 'nodisplay)) +;; (setq event (read-event))) +;; (or (eq initial-event-type (event-basic-type event)) +;; (error ""))) +;; event) (defun foldout-mouse-goto-heading (event) "Go to the heading where the mouse event started. Signal an error if the event didn't occur on a heading." - (goto-char (posn-point (event-start event))) + ;; XEmacs change. + (goto-char (event-point event)) (or (outline-on-heading-p) ;; outline.el sometimes treats beginning-of-buffer as a heading ;; even though outline-on-heading returns nil. @@ -515,10 +525,25 @@ "List of modifier keys to apply to foldout's mouse events. The default (meta control) makes foldout bind its functions to -M-C-down-mouse-{1,2,3}. +(meta control button{1,2,3}). Valid modifiers are shift, control, meta, alt, hyper and super.") +;; XEmacs change. +(defun foldout-mouse-track-click-hook (event click-count) + (if (and (memq click-count '(1 2 3 4)) + (eq (event-modifier-bits + (make-event 'button-release + `(button 1 modifiers ,foldout-mouse-modifiers))) + (event-modifier-bits event))) + (let ((button (event-button event))) + (cond ((eq button 1) + (funcall 'foldout-mouse-zoom event click-count)) + ((eq button 2) + (funcall 'foldout-mouse-show event click-count)) + ((eq button 3) + (funcall 'foldout-mouse-hide-or-exit event click-count)))))) + (if foldout-inhibit-key-bindings () (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree) @@ -528,32 +553,26 @@ (define-key outline-minor-mode-map (concat outline-minor-mode-prefix "\C-x") 'foldout-exit-fold) - (let* ((modifiers (apply 'concat - (mapcar (function - (lambda (modifier) - (vector - (cond - ((eq modifier 'shift) ?S) - ((eq modifier 'control) ?C) - ((eq modifier 'meta) ?M) - ((eq modifier 'alt) ?A) - ((eq modifier 'hyper) ?H) - ((eq modifier 'super) ?s) - (t (error "invalid mouse modifier %s" - modifier))) - ?-))) - foldout-mouse-modifiers))) - (mouse-1 (vector (intern (concat modifiers "down-mouse-1")))) - (mouse-2 (vector (intern (concat modifiers "down-mouse-2")))) - (mouse-3 (vector (intern (concat modifiers "down-mouse-3"))))) - - (define-key outline-mode-map mouse-1 'foldout-mouse-zoom) - (define-key outline-mode-map mouse-2 'foldout-mouse-show) - (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit) - - (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom) - (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show) - (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit) + (add-hook 'outline-mode-hook + (lambda () + (add-hook 'mouse-track-click-hook + 'foldout-mouse-track-click-hook))) + (add-hook 'outline-minor-mode-hook + (lambda () + (add-hook 'mouse-track-click-hook + 'foldout-mouse-track-click-hook))) + ;; XEmacs change + (let ((mouse-1 (vector (append foldout-mouse-modifiers '(button1)))) + (mouse-2 (vector (append foldout-mouse-modifiers '(button2)))) + (mouse-3 (vector (append foldout-mouse-modifiers '(button3))))) + + (define-key outline-mode-map mouse-1 'mouse-track) + (define-key outline-mode-map mouse-2 'mouse-track) + (define-key outline-mode-map mouse-3 'mouse-track) + + (define-key outline-minor-mode-map mouse-1 'mouse-track) + (define-key outline-minor-mode-map mouse-2 'mouse-track) + (define-key outline-minor-mode-map mouse-3 'mouse-track) )) (provide 'foldout)