all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: "Ken Manheimer" <ken.manheimer@gmail.com>
Cc: emacs-devel@gnu.org
Subject: Re: allout bug
Date: Thu, 21 Sep 2006 12:51:09 -0400	[thread overview]
Message-ID: <2cd46e7f0609210951o11f14256w272ca6915dfb1841@mail.gmail.com> (raw)
In-Reply-To: <87eju54ayh.fsf@escher.local.home>

[-- Attachment #1: Type: text/plain, Size: 10966 bytes --]

On 9/21/06, Stephen Berman <Stephen.Berman@gmx.net> wrote:
> If you call allout-show-current-branches on a heading that contains
> subheadings, it raises a "Wrong type argument: number-or-marker-p"
> error.[1] You also get this error if you use `+' in an exposure-spec
> applied to a heading that contains subheadings.  The reason in both
> cases is that allout-show-current-branches calls allout-show-children
> with argument `t', which is passed to the `levels' argument of
> allout-chart-subtree and there barfs on the first numerical comparison
> test it hits.  I don't know what the best fix for this is, but the
> following patch to allout-chart-subtree has worked fine for me so far,
> though it looks like an ugly hack:

you discovered some incoherence in the way that allout-chart-subtree,
allout-chart-to-reveal, and allout-show-children treated their level
parameters.

i think the right thing is for the two chart routines to treat a nil
level parameter as unlimited, but allout-show-children needs to
default it to 1, so it needs the value of t to mean unlimited.  it
used to be that allout-chart-subtree would have the same
interpretation of t, but that was never advertised, and i think it's
incorrect.

among other things, the following (and attached) patch changes the
signatures so that the level parameter is treated as described above.
i think it rectifies the problem you found, and leaves the specific
level settings working properly.  (i think your patch might disrupt
the latter, but getting the use of the level paramater rational and
explicit is worthwhile, in any case.)

i'd appreciate if you would try out the new version before anyone
commits it to the repository.

(my patch includes some other things i've accumulated, including a fix
for a rather obsure bug, running of a more suitable allout change hook
at one point, and introduction of needed copy-as-kill wrappers for
allout-kill-topic and allout-kill-line.  i'll detail these properly
with a ChangeLog entry once the fix in question is confirmed.)

i'm also curious whether your use of the allout-show-current-branches
means that you're playing with extending allout?  it seems a bit out
of the way in typical interactive use.  or do you have a binding for
it, for interactive use?  i just use a repeat count with
allout-show-children for that purpose...

anyway, thanks for the clear, helpful bug report, and your digging to
flesh it out!
-- 
ken
ken.manheimer@gmail.com
http://myriadicity.net

Index: allout.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/allout.el,v
retrieving revision 1.83
diff -u -u -r1.83 allout.el
--- allout.el	16 Sep 2006 10:24:24 -0000	1.83
+++ allout.el	21 Sep 2006 16:38:56 -0000
@@ -698,9 +698,11 @@
         ("*" allout-rebullet-current-heading)
         ("#" allout-number-siblings)
         ("\C-k" allout-kill-line t)
+        ("\M-k" allout-copy-line-as-kill t)
         ("\C-y" allout-yank t)
         ("\M-y" allout-yank-pop t)
         ("\C-k" allout-kill-topic)
+        ("\M-k" allout-copy-topic-as-kill)
                                         ; Miscellaneous commands:
 	;([?\C-\ ] allout-mark-topic)
         ("@" allout-resolve-xref)
@@ -1279,7 +1281,7 @@
 ;;;_   > allout-unprotected (expr)
 (defmacro allout-unprotected (expr)
   "Enable internal outline operations to alter invisible text."
-  `(let ((inhibit-read-only t)
+  `(let ((inhibit-read-only (if (not buffer-read-only) t))
          (inhibit-field-text-motion t))
      ,expr))
 ;;;_   = allout-mode-hook
@@ -1693,7 +1695,9 @@
 	Topic-oriented Killing and Yanking:
 	----------------------------------
 \\[allout-kill-topic]	allout-kill-topic	Kill current topic, including
offspring.
-\\[allout-kill-line]	allout-kill-line	Like kill-line, but reconciles
numbering, etc.
+\\[allout-copy-topic-as-kill]	allout-copy-topic-as-kill Copy current
topic, including offspring.
+\\[allout-kill-line]	allout-kill-line	kill-line, attending to outline
structure.
+\\[allout-copy-line-as-kill]	allout-copy-line-as-kill Copy line but
don't delete it.
 \\[allout-yank]	allout-yank		Yank, adjusting depth of yanked topic to
 				depth of heading if yanking into bare topic
 				heading (ie, prefix sans text).
@@ -2087,10 +2091,7 @@
 (defun allout-before-change-handler (beg end)
   "Protect against changes to invisible text.

-See allout-overlay-interior-modification-handler for details.
-
-This before-change handler is used only where modification-hooks
-overlay property is not supported."
+See allout-overlay-interior-modification-handler for details."

   (if (and (allout-mode-p) undo-in-progress (allout-hidden-p))
       (allout-show-to-offshoot))
@@ -2201,8 +2202,9 @@
   (save-excursion
     (allout-beginning-of-current-line)
     (and (looking-at allout-regexp)
-         (not (allout-aberrant-container-p))
-	 (allout-prefix-data))))
+         (allout-prefix-data)
+         (or (> allout-recent-depth allout-doublecheck-at-and-shallower)
+             (not (allout-aberrant-container-p))))))
 ;;;_    > allout-on-heading-p ()
 (defalias 'allout-on-heading-p 'allout-on-current-heading-p)
 ;;;_    > allout-e-o-prefix-p ()
@@ -2328,7 +2330,7 @@

   (save-excursion
     (cond ((and depth (<= depth 0) 0))
-          ((or (not depth) (= depth (allout-depth)))
+          ((or (null depth) (= depth (allout-depth)))
            (let ((index 1))
              (while (allout-previous-sibling allout-recent-depth nil)
 	       (setq index (1+ index)))
@@ -2504,13 +2506,13 @@
 (defun allout-chart-subtree (&optional levels visible orig-depth prev-depth)
   "Produce a location \"chart\" of subtopics of the containing topic.

-Optional argument LEVELS specifies the depth \(relative to start
-depth) for the chart.
+Optional argument LEVELS specifies a depth limit \(relative to start
+depth) for the chart.  Null LEVELS means no limit.

 When optional argument VISIBLE is non-nil, the chart includes
 only the visible subelements of the charted subjects.

-The remaining optional args are not for internal use by the function.
+The remaining optional args are for internal use by the function.

 Point is left at the end of the subtree.

@@ -2617,16 +2619,19 @@

   "Return a flat list of hidden points in subtree CHART, up to DEPTH.

+If DEPTH is nil, include hidden points at any depth.
+
 Note that point can be left at any of the points on chart, or at the
 start point."

   (let (result here)
-    (while (and (or (eq depth t) (> depth 0))
+    (while (and (or (null depth) (> depth 0))
 		chart)
       (setq here (car chart))
       (if (listp here)
-	  (let ((further (allout-chart-to-reveal here (or (eq depth t)
-							   (1- depth)))))
+	  (let ((further (allout-chart-to-reveal here (if (null depth)
+                                                          depth
+                                                        (1- depth)))))
 	    ;; We're on the start of a subtree - recurse with it, if there's
 	    ;; more depth to go:
 	    (if further (setq result (append further result)))
@@ -4187,6 +4192,14 @@
                 (allout-next-heading))
             (allout-renumber-to-depth depth)))
       (run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
+;;;_    > allout-copy-line-as-kill ()
+(defun allout-copy-line-as-kill ()
+  "Like allout-kill-topic, but save to kill ring instead of deleting."
+  (interactive)
+  (let ((buffer-read-only t))
+    (condition-case nil
+        (allout-kill-line)
+      (buffer-read-only nil))))
 ;;;_    > allout-kill-topic ()
 (defun allout-kill-topic ()
   "Kill topic together with subtopics.
@@ -4223,11 +4236,20 @@
     (save-excursion
       (allout-renumber-to-depth depth))
     (run-hook-with-args 'allout-structure-deleted-hook depth (point))))
+;;;_    > allout-copy-topic-as-kill ()
+(defun allout-copy-topic-as-kill ()
+  "Like allout-kill-topic, but save to kill ring instead of deleting."
+  (interactive)
+  (let ((buffer-read-only t))
+    (condition-case nil
+        (allout-kill-topic)
+      (buffer-read-only (message "Topic copied...")))))
 ;;;_    > allout-annotate-hidden (begin end)
 (defun allout-annotate-hidden (begin end)
   "Qualify text with properties to indicate exposure status."

-  (let ((was-modified (buffer-modified-p)))
+  (let ((was-modified (buffer-modified-p))
+        (buffer-read-only nil))
     (allout-unprotected
      (remove-text-properties begin end '(allout-was-hidden t)))
     (save-excursion
@@ -4237,8 +4259,10 @@
           ;; at or advance to start of next hidden region:
           (if (not (allout-hidden-p))
               (setq next
-                    (next-single-char-property-change (point)
-                                                      'invisible nil end)))
+                    (max (1+ (point))
+                         (next-single-char-property-change (point)
+                                                           'invisible
+                                                           nil end))))
           (if (or (not next) (eq prev next))
               ;; still not at start of hidden area - must not be any left.
               (setq done t)
@@ -4600,8 +4624,13 @@
         (allout-beginning-of-current-line)
         (save-restriction
           (let* (depth
-                 (chart (allout-chart-subtree (or level 1)))
-                 (to-reveal (or (allout-chart-to-reveal chart (or level 1))
+                 ;; translate the level spec for this routine to the ones
+                 ;; used by -chart-subtree and -chart-to-reveal:
+                 (chart-level (cond ((not level) 1)
+                                    ((eq level t) nil)
+                                    (t level)))
+                 (chart (allout-chart-subtree chart-level))
+                 (to-reveal (or (allout-chart-to-reveal chart chart-level)
                                 ;; interactive, show discontinuous children:
                                 (and chart
                                      (interactive-p)
@@ -5169,7 +5198,8 @@
                          (allout-back-to-visible-text)))
 		      strings))
 	  (when (< (point) next)      ; Resume from after hid text, if any.
-            (line-move 1))
+            (line-move 1)
+            (beginning-of-line))
 	  (setq beg (point)))
 	;; Accumulate list for this topic:
 	(setq strings (nreverse strings))
@@ -5745,8 +5775,8 @@
            ;; Add the is-encrypted bullet qualifier:
            (goto-char after-bullet-pos)
            (insert "*"))))
-      (run-hook-with-args 'allout-exposure-changed-hook
-                          bullet-pos subtree-end nil))))
+      (run-hook-with-args 'allout-structure-added-hook
+                          bullet-pos subtree-end))))
 ;;;_  > allout-encrypt-string (text decrypt allout-buffer key-type for-key
 ;;;                                  fetch-pass &optional retried verifying
 ;;;                                  passphrase)

[-- Attachment #2: allout-patch.txt --]
[-- Type: text/plain, Size: 8494 bytes --]

Index: allout.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/allout.el,v
retrieving revision 1.83
diff -u -u -r1.83 allout.el
--- allout.el	16 Sep 2006 10:24:24 -0000	1.83
+++ allout.el	21 Sep 2006 16:38:56 -0000
@@ -698,9 +698,11 @@
         ("*" allout-rebullet-current-heading)
         ("#" allout-number-siblings)
         ("\C-k" allout-kill-line t)
+        ("\M-k" allout-copy-line-as-kill t)
         ("\C-y" allout-yank t)
         ("\M-y" allout-yank-pop t)
         ("\C-k" allout-kill-topic)
+        ("\M-k" allout-copy-topic-as-kill)
                                         ; Miscellaneous commands:
 	;([?\C-\ ] allout-mark-topic)
         ("@" allout-resolve-xref)
@@ -1279,7 +1281,7 @@
 ;;;_   > allout-unprotected (expr)
 (defmacro allout-unprotected (expr)
   "Enable internal outline operations to alter invisible text."
-  `(let ((inhibit-read-only t)
+  `(let ((inhibit-read-only (if (not buffer-read-only) t))
          (inhibit-field-text-motion t))
      ,expr))
 ;;;_   = allout-mode-hook
@@ -1693,7 +1695,9 @@
 	Topic-oriented Killing and Yanking:
 	----------------------------------
 \\[allout-kill-topic]	allout-kill-topic	Kill current topic, including offspring.
-\\[allout-kill-line]	allout-kill-line	Like kill-line, but reconciles numbering, etc.
+\\[allout-copy-topic-as-kill]	allout-copy-topic-as-kill Copy current topic, including offspring.
+\\[allout-kill-line]	allout-kill-line	kill-line, attending to outline structure.
+\\[allout-copy-line-as-kill]	allout-copy-line-as-kill Copy line but don't delete it.
 \\[allout-yank]	allout-yank		Yank, adjusting depth of yanked topic to
 				depth of heading if yanking into bare topic
 				heading (ie, prefix sans text).
@@ -2087,10 +2091,7 @@
 (defun allout-before-change-handler (beg end)
   "Protect against changes to invisible text.
 
-See allout-overlay-interior-modification-handler for details.
-
-This before-change handler is used only where modification-hooks
-overlay property is not supported."
+See allout-overlay-interior-modification-handler for details."
 
   (if (and (allout-mode-p) undo-in-progress (allout-hidden-p))
       (allout-show-to-offshoot))
@@ -2201,8 +2202,9 @@
   (save-excursion
     (allout-beginning-of-current-line)
     (and (looking-at allout-regexp)
-         (not (allout-aberrant-container-p))
-	 (allout-prefix-data))))
+         (allout-prefix-data)
+         (or (> allout-recent-depth allout-doublecheck-at-and-shallower)
+             (not (allout-aberrant-container-p))))))
 ;;;_    > allout-on-heading-p ()
 (defalias 'allout-on-heading-p 'allout-on-current-heading-p)
 ;;;_    > allout-e-o-prefix-p ()
@@ -2328,7 +2330,7 @@
 
   (save-excursion
     (cond ((and depth (<= depth 0) 0))
-          ((or (not depth) (= depth (allout-depth)))
+          ((or (null depth) (= depth (allout-depth)))
            (let ((index 1))
              (while (allout-previous-sibling allout-recent-depth nil)
 	       (setq index (1+ index)))
@@ -2504,13 +2506,13 @@
 (defun allout-chart-subtree (&optional levels visible orig-depth prev-depth)
   "Produce a location \"chart\" of subtopics of the containing topic.
 
-Optional argument LEVELS specifies the depth \(relative to start
-depth) for the chart.
+Optional argument LEVELS specifies a depth limit \(relative to start
+depth) for the chart.  Null LEVELS means no limit.
 
 When optional argument VISIBLE is non-nil, the chart includes
 only the visible subelements of the charted subjects.
 
-The remaining optional args are not for internal use by the function.
+The remaining optional args are for internal use by the function.
 
 Point is left at the end of the subtree.
 
@@ -2617,16 +2619,19 @@
 
   "Return a flat list of hidden points in subtree CHART, up to DEPTH.
 
+If DEPTH is nil, include hidden points at any depth.
+
 Note that point can be left at any of the points on chart, or at the
 start point."
 
   (let (result here)
-    (while (and (or (eq depth t) (> depth 0))
+    (while (and (or (null depth) (> depth 0))
 		chart)
       (setq here (car chart))
       (if (listp here)
-	  (let ((further (allout-chart-to-reveal here (or (eq depth t)
-							   (1- depth)))))
+	  (let ((further (allout-chart-to-reveal here (if (null depth)
+                                                          depth
+                                                        (1- depth)))))
 	    ;; We're on the start of a subtree - recurse with it, if there's
 	    ;; more depth to go:
 	    (if further (setq result (append further result)))
@@ -4187,6 +4192,14 @@
                 (allout-next-heading))
             (allout-renumber-to-depth depth)))
       (run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
+;;;_    > allout-copy-line-as-kill ()
+(defun allout-copy-line-as-kill ()
+  "Like allout-kill-topic, but save to kill ring instead of deleting."
+  (interactive)
+  (let ((buffer-read-only t))
+    (condition-case nil
+        (allout-kill-line)
+      (buffer-read-only nil))))
 ;;;_    > allout-kill-topic ()
 (defun allout-kill-topic ()
   "Kill topic together with subtopics.
@@ -4223,11 +4236,20 @@
     (save-excursion
       (allout-renumber-to-depth depth))
     (run-hook-with-args 'allout-structure-deleted-hook depth (point))))
+;;;_    > allout-copy-topic-as-kill ()
+(defun allout-copy-topic-as-kill ()
+  "Like allout-kill-topic, but save to kill ring instead of deleting."
+  (interactive)
+  (let ((buffer-read-only t))
+    (condition-case nil
+        (allout-kill-topic)
+      (buffer-read-only (message "Topic copied...")))))
 ;;;_    > allout-annotate-hidden (begin end)
 (defun allout-annotate-hidden (begin end)
   "Qualify text with properties to indicate exposure status."
 
-  (let ((was-modified (buffer-modified-p)))
+  (let ((was-modified (buffer-modified-p))
+        (buffer-read-only nil))
     (allout-unprotected
      (remove-text-properties begin end '(allout-was-hidden t)))
     (save-excursion
@@ -4237,8 +4259,10 @@
           ;; at or advance to start of next hidden region:
           (if (not (allout-hidden-p))
               (setq next
-                    (next-single-char-property-change (point)
-                                                      'invisible nil end)))
+                    (max (1+ (point))
+                         (next-single-char-property-change (point)
+                                                           'invisible
+                                                           nil end))))
           (if (or (not next) (eq prev next))
               ;; still not at start of hidden area - must not be any left.
               (setq done t)
@@ -4600,8 +4624,13 @@
         (allout-beginning-of-current-line)
         (save-restriction
           (let* (depth
-                 (chart (allout-chart-subtree (or level 1)))
-                 (to-reveal (or (allout-chart-to-reveal chart (or level 1))
+                 ;; translate the level spec for this routine to the ones
+                 ;; used by -chart-subtree and -chart-to-reveal:
+                 (chart-level (cond ((not level) 1)
+                                    ((eq level t) nil)
+                                    (t level)))
+                 (chart (allout-chart-subtree chart-level))
+                 (to-reveal (or (allout-chart-to-reveal chart chart-level)
                                 ;; interactive, show discontinuous children:
                                 (and chart
                                      (interactive-p)
@@ -5169,7 +5198,8 @@
                          (allout-back-to-visible-text)))
 		      strings))
 	  (when (< (point) next)      ; Resume from after hid text, if any.
-            (line-move 1))
+            (line-move 1)
+            (beginning-of-line))
 	  (setq beg (point)))
 	;; Accumulate list for this topic:
 	(setq strings (nreverse strings))
@@ -5745,8 +5775,8 @@
            ;; Add the is-encrypted bullet qualifier:
            (goto-char after-bullet-pos)
            (insert "*"))))
-      (run-hook-with-args 'allout-exposure-changed-hook
-                          bullet-pos subtree-end nil))))
+      (run-hook-with-args 'allout-structure-added-hook
+                          bullet-pos subtree-end))))
 ;;;_  > allout-encrypt-string (text decrypt allout-buffer key-type for-key
 ;;;                                  fetch-pass &optional retried verifying
 ;;;                                  passphrase)

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel

      reply	other threads:[~2006-09-21 16:51 UTC|newest]

Thread overview: 2+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2006-09-21 13:15 allout bug Stephen Berman
2006-09-21 16:51 ` Ken Manheimer [this message]

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=2cd46e7f0609210951o11f14256w272ca6915dfb1841@mail.gmail.com \
    --to=ken.manheimer@gmail.com \
    --cc=emacs-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.