Browse Source

Fix block hiding

* lisp/org.el (org-hide-block-toggle): Correctly find boundaries of
  the block at point.  Fix `off' argument behavior.  Allow to hide
  a block when at any affiliated keyword.

* testing/lisp/test-org.el (test-org/hide-block-toggle): New test.

Thanks to Andrea Rossetti for reporting it.
http://permalink.gmane.org/gmane.emacs.orgmode/89324
Nicolas Goaziou 10 years ago
parent
commit
cdb85242d6
2 changed files with 97 additions and 34 deletions
  1. 48 34
      lisp/org.el
  2. 49 0
      testing/lisp/test-org.el

+ 48 - 34
lisp/org.el

@@ -7325,41 +7325,55 @@ Optional arguments START and END can be used to limit the range."
       nil))) ;; to signal that we did not
 
 (defun org-hide-block-toggle (&optional force)
-  "Toggle the visibility of the current block."
+  "Toggle the visibility of the current block.
+When optional argument FORCE is `off', make block visible.  If it
+is non-nil, hide it unconditionally."
   (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (if (re-search-forward org-block-regexp nil t)
-        (let ((start (- (match-beginning 4) 1)) ;; beginning of body
-              (end (match-end 0)) ;; end of entire body
-              ov)
-          (if (memq t (mapcar (lambda (overlay)
-                                (eq (overlay-get overlay 'invisible)
-				    'org-hide-block))
-                              (overlays-at start)))
-              (if (or (not force) (eq force 'off))
-                  (mapc (lambda (ov)
-                          (when (member ov org-hide-block-overlays)
-                            (setq org-hide-block-overlays
-                                  (delq ov org-hide-block-overlays)))
-                          (when (eq (overlay-get ov 'invisible)
-                                    'org-hide-block)
-                            (delete-overlay ov)))
-                        (overlays-at start)))
-            (setq ov (make-overlay start end))
-            (overlay-put ov 'invisible 'org-hide-block)
-            ;; make the block accessible to isearch
-            (overlay-put
-             ov 'isearch-open-invisible
-             (lambda (ov)
-               (when (member ov org-hide-block-overlays)
-                 (setq org-hide-block-overlays
-                       (delq ov org-hide-block-overlays)))
-               (when (eq (overlay-get ov 'invisible)
-                         'org-hide-block)
-                 (delete-overlay ov))))
-            (push ov org-hide-block-overlays)))
-      (user-error "Not looking at a source block"))))
+  (let ((element (org-element-at-point)))
+    (unless (memq (org-element-type element)
+		  '(center-block comment-block example-block quote-block
+				 src-block verse-block))
+      (user-error "Not at a block"))
+    (let* ((start (save-excursion
+		    (goto-char (org-element-property :post-affiliated element))
+		    (line-end-position)))
+	   (end (save-excursion
+		  (goto-char (org-element-property :end element))
+		  (skip-chars-backward " \r\t\n")
+		  (line-end-position)))
+	   (overlays (overlays-at start)))
+      (cond
+       ;; Do nothing when not before or at the block opening line or
+       ;; at the block closing line.
+       ((let ((eol (line-end-position)))
+	  (and (> eol start) (/= eol end))))
+       ((and (not (eq force 'off))
+	     (not (memq t (mapcar
+			   (lambda (o)
+			     (eq (overlay-get o 'invisible) 'org-hide-block))
+			   overlays))))
+	(let ((ov (make-overlay start end)))
+	  (overlay-put ov 'invisible 'org-hide-block)
+	  ;; Make the block accessible to `isearch'.
+	  (overlay-put
+	   ov 'isearch-open-invisible
+	   (lambda (ov)
+	     (when (memq ov org-hide-block-overlays)
+	       (setq org-hide-block-overlays (delq ov org-hide-block-overlays)))
+	     (when (eq (overlay-get ov 'invisible) 'org-hide-block)
+	       (delete-overlay ov))))
+	  (push ov org-hide-block-overlays)
+	  ;; When the block is hidden away, make sure point is left in
+	  ;; a visible part of the buffer.
+	  (when (> (line-beginning-position) start)
+	    (goto-char start)
+	    (beginning-of-line))))
+       ((or (not force) (eq force 'off))
+	(dolist (ov overlays)
+	  (when (memq ov org-hide-block-overlays)
+	    (setq org-hide-block-overlays (delq ov org-hide-block-overlays)))
+	  (when (eq (overlay-get ov 'invisible) 'org-hide-block)
+	    (delete-overlay ov))))))))
 
 ;; org-tab-after-check-for-cycling-hook
 (add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe)

+ 49 - 0
testing/lisp/test-org.el

@@ -1902,6 +1902,55 @@ Text.
      (org-flag-drawer t)
      (get-char-property (point) 'invisible))))
 
+(ert-deftest test-org/hide-block-toggle ()
+  "Test `org-hide-block-toggle' specifications."
+  ;; Error when not at a block.
+  (should-error
+   (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents"
+     (org-hide-block-toggle 'off)
+     (get-char-property (line-end-position) 'invisible)))
+  ;; Hide block.
+  (should
+   (org-test-with-temp-text "#+BEGIN_CENTER\ncontents\n#+END_CENTER"
+     (org-hide-block-toggle)
+     (get-char-property (line-end-position) 'invisible)))
+  (should
+   (org-test-with-temp-text "#+BEGIN_EXAMPLE\ncontents\n#+END_EXAMPLE"
+     (org-hide-block-toggle)
+     (get-char-property (line-end-position) 'invisible)))
+  ;; Show block unconditionally when optional argument is `off'.
+  (should-not
+   (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
+     (org-hide-block-toggle)
+     (org-hide-block-toggle 'off)
+     (get-char-property (line-end-position) 'invisible)))
+  (should-not
+   (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
+     (org-hide-block-toggle 'off)
+     (get-char-property (line-end-position) 'invisible)))
+  ;; Hide block unconditionally when optional argument is non-nil.
+  (should
+   (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
+     (org-hide-block-toggle t)
+     (get-char-property (line-end-position) 'invisible)))
+  (should
+   (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
+     (org-hide-block-toggle)
+     (org-hide-block-toggle t)
+     (get-char-property (line-end-position) 'invisible)))
+  ;; Do not hide block when called from final blank lines.
+  (should-not
+   (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE\n\n<point>"
+     (org-hide-block-toggle)
+     (goto-char (point-min))
+     (get-char-property (line-end-position) 'invisible)))
+  ;; Don't leave point in an invisible part of the buffer when hiding
+  ;; a block away.
+  (should-not
+   (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n<point>#+END_QUOTE"
+     (org-hide-block-toggle)
+     (get-char-property (point) 'invisible))))
+
 
 (provide 'test-org)