Commits

sperber-guest  committed 177faa2

2010-04-23 Mike Sperber <mike@xemacs.org>

* outline.el: Replace with slightly hacked noutline.el from
current org-mode.

2010-04-23 Mike Sperber <mike@xemacs.org>

* outl-mouse.el (outline-heading-add-glyph-1): Rename the extent
property to 'outl-mouse to get out of the way of the new outline mode.
(outline-heading-add-glyph-1): Disable `outline-glyphs-on-left':
Doesn't currently work (see comment in file.)
(outline-sync-visible-sub-headings-in-region): Use
`outline-invisible-p' instead of checking for C-M.
(outline-fold-in): Rename `annotation-reveal' (obsolete) to
`reveal-annotation', ditto for `annotation-hide'.
(outline-hidden-p): Check for `invisible' property instead of for
C-M.
(outline-up-click): Abstract over commonalities with
`outline-down-click'; always set the correct buffer.

  • Participants
  • Parent commits 129ef81

Comments (0)

Files changed (2)

+2010-04-23  Mike Sperber  <mike@xemacs.org>
+
+	* outl-mouse.el (outline-heading-add-glyph-1): Rename the extent
+	property to 'outl-mouse to get out of the way of the new outline mode.
+	(outline-heading-add-glyph-1): Disable `outline-glyphs-on-left':
+	Doesn't currently work (see comment in file.)
+	(outline-sync-visible-sub-headings-in-region): Use
+	`outline-invisible-p' instead of checking for C-M.
+	(outline-fold-in): Rename `annotation-reveal' (obsolete) to
+	`reveal-annotation', ditto for `annotation-hide'.
+	(outline-hidden-p): Check for `invisible' property instead of for
+	C-M.
+	(outline-up-click): Abstract over commonalities with
+	`outline-down-click'; always set the correct buffer.
+
 2009-08-16  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 2.42 released.

File outl-mouse.el

 ;>              (setq funclist (cons funcname funclist))
 ;>              (save-excursion (run-hooks 'fume-found-function-hook))))
 
-;; If you  want mac-style outlining  then set  outline-mac-style to t.
-;; If you   want    the  outline   arrows on    the    left then   set
-;; outline-glyphs-on-left  to t. If you  have xpm then arrows are much
-;; better defined.
+;; If you want mac-style outlining then set outline-mac-style to t.
+;; If you have xpm then arrows are much better defined.
 
 ;; This package uses func-menu to  define outline regexps if they  are
 ;; not already defined. You should no longer need to use out-xtra.
   :type 'boolean
   :group 'outl-mouse)
 
-(defcustom outline-glyphs-on-left nil
-  "*The position of outline glyphs on a line."
+; #### Mike Sperber says: I haven't found a way to make annotation
+; glyphs display on the right of the header of a hidden heading: The
+; invisiblity hides the glyphs.
+
+(defcustom outline-glyphs-on-left t
+  "*The position of outline glyphs on a line.
+Note: This setting is currently being ignored:
+The outline glyphs are always on the left."
   :type 'boolean
   :group 'outl-mouse)
 
 	 (goto-char (extent-start-position ext))
 	 (beginning-of-line)
 	 (outline-on-heading-p))
-       (extent-property ext 'outline))
+       (extent-property ext 'outl-mouse))
       (delete-annotation ext))
   nil)
 
 	   (make-annotation (if outline-mac-style 
 				outline-right-arrow
 			      outline-down-arrow)
-			    (save-excursion (if outline-glyphs-on-left nil
+			    (save-excursion (if t ; disabled: outline-glyphs-on-left 
+						nil
 					      (outline-end-of-heading))
 					    (point))
 			    'text nil t 
 	   (make-annotation (if outline-mac-style
 				outline-down-arrow
 			      outline-up-arrow)
-			    (save-excursion (if outline-glyphs-on-left nil
+			    (save-excursion (if t ; disabled: outline-glyphs-on-left 
+						nil
 					      (outline-end-of-heading))
 					    (point))
 			    'text nil t 
 			      outline-up-arrow-mask))))
       ;; we cunningly make the annotation data point to its twin.
       (set-annotation-data anot1 anot2)
-      (set-extent-property anot1 'outline 'up)
+      (set-extent-property anot1 'outl-mouse 'up)
       (set-annotation-action anot1 'outline-up-click)
       (set-annotation-menu anot1 outline-glyph-menu)
       (set-extent-priority anot1 1)
       (set-annotation-data anot2 anot1)
-      (set-extent-property anot2 'outline 'down)
+      (set-extent-property anot2 'outl-mouse 'down)
       (set-annotation-menu anot2 outline-glyph-menu)
       (set-annotation-action anot2 'outline-down-click)
-      (annotation-hide anot2))
+      (hide-annotation anot2))
     t))
 
 (defun outline-heading-has-glyph-p ()
   (catch 'found
     (mapcar
      '(lambda(a)
-	(if (extent-property a 'outline)
+	(if (extent-property a 'outl-mouse)
 	    (throw 'found t)))
      (annotations-in-region (save-excursion (outline-back-to-heading) (point))
 			    (save-excursion (outline-end-of-heading) 
   (mapcar '(lambda (x) 
 	     (goto-char (extent-start-position x))
 	     (beginning-of-line)
-	     (cond ((and (eq (extent-property x 'outline) 'down)
+	     (cond ((and (eq (extent-property x 'outl-mouse) 'down)
 			 ;; skip things we can't see
-			 (not (eq (preceding-char) ?\^M)))
+			 (not (outline-invisible-p (point-at-eol))))
 		    (if (outline-more-to-hide)
 			;; reveal my twin
-			(annotation-reveal (annotation-data x))
-		      (annotation-hide (annotation-data x)))
+			(reveal-annotation (annotation-data x))
+		      (hide-annotation (annotation-data x)))
 		    (if (not (outline-hidden-p))
 			;; hide my self
-			(annotation-hide x)
-		      (annotation-reveal x)))))
+			(hide-annotation x)
+		      (reveal-annotation x)))))
 	  (annotations-in-region pmin pmax (current-buffer))))
 
 (defun outline-sync-visible-sub-headings ()
 ;		  (save-excursion (outline-next-heading) 
 ;				  (if (eobp) nil (point)))))
   (if (save-excursion (outline-next-heading) 
-		      (eq (preceding-char) ?\^M))
+		      (outline-invisible-p (point-at-eol)))
       (progn 
 	(save-excursion (show-children))
 	(outline-sync-visible-sub-headings))
 	(progn 
 	  (save-excursion (show-entry))
 	  ;; reveal my twin and hide me
-	  (annotation-hide annotation)
-	  (annotation-reveal (annotation-data annotation))))))
+	  (hide-annotation annotation)
+	  (reveal-annotation (annotation-data annotation))))))
 
 (defun outline-fold-in (annotation)
   "Fold in the current heading."
       (progn
 	(save-excursion (hide-entry))
 	(if (not (outline-more-to-hide))
-	    (annotation-hide annotation))
-	(annotation-reveal (annotation-data annotation)))
+	    (hide-annotation annotation))
+	(reveal-annotation (annotation-data annotation)))
     ;; otherwise look for more leaves
     (save-excursion 
       (if (outline-more-to-hide t)
       (if (not end-of-entry)
 	  (setq end-of-entry (point-max)))
       (outline-back-to-heading)
-      ;; If there are ANY ^M's, the entry is hidden.
-      (search-forward "\^M" end-of-entry t))))
+      ;; If anything is invisible, the entry is hidden.
+      (map-extents #'(lambda (extent _)
+		       (eq 'outline (extent-property extent 'invisible)))
+		   (current-buffer)
+		   (point) end-of-entry nil nil 'invisible))))
 
 (defun outline-next-visible-heading-safe ()
   "Safely go to the next visible heading. 
 (defun outline-up-click (data ev)
   "Annotation action for clicking on an up arrow.
 DATA is the annotation data. EV is the mouse click event."
-  (save-excursion
-    (goto-char (extent-end-position (event-glyph-extent ev)))
-    (funcall outline-fold-in-function (event-glyph-extent ev)))
-  (if outline-move-point-after-click
-      (progn
-	(goto-char (extent-end-position (event-glyph-extent ev)))
-	(beginning-of-line))))
-; This line demonstrates a bug in redisplay
+  (outline-click data ev outline-fold-in-function))
+
 (defun outline-down-click (data ev)
-  "Annotation action for clicking on a down arrow.
+  "Annotation action for clicking on an up arrow.
 DATA is the annotation data. EV is the mouse click event."
-  (save-excursion
-    (goto-char (extent-end-position (event-glyph-extent ev)))
-    (funcall outline-fold-out-function (event-glyph-extent ev)))
-  (if outline-move-point-after-click
-      (progn
-	(goto-char (extent-end-position (event-glyph-extent ev)))
-	(beginning-of-line))))
-
+  (outline-click data ev outline-fold-out-function))
+ 
+(defun outline-click (data ev fold-function)
+  "Annotation action for clicking on an arrow.
+DATA is the annotation data. EV is the mouse click event,
+FUNCTION is either `outline-fold-in-function' or `outline-fold-out-function'."
+  (let ((buffer (event-buffer ev)))
+    (save-excursion
+      (set-buffer buffer)
+      (goto-char (extent-end-position (event-glyph-extent ev)))
+      (funcall fold-function (event-glyph-extent ev)))
+    (if outline-move-point-after-click
+	(progn
+	  (goto-char (extent-end-position (event-glyph-extent ev)) buffer)
+	  (beginning-of-line nil buffer)))))
 
 (provide 'outl-mouse)
 (provide 'outln-18)			; fool auctex - outline is ok now.