Org Visibility

[Doerthous]

---

注：此贴采取另一种更新策略：尽可能保持行文逻辑结构，而非线性记录变更历史。

---

Org 元素可见性

与 PC 端大屏幕相比，在手机上使用 Org-mode 时，为优化笔记/文本浏览体验，常常需要隐藏某些 Org 元素，比如隐藏 tags, 隐藏 property-drawer, timestamp, 代码块的界定符等。

因为某些元素非 Org-element, 于是…

#+name: 2025-07-26-20-47
#+begin: elisp-docstring

Org （元素）可见性。

几个术语：

vtype: visibility type;
etype: org element type;
xtype: extend element type;

vtype = etype + xtype.

使用：

1 作为命令使用，即 M-x org-visibility:

作为命令使用时，切换单个 vtype 的可见性。

2 作为代码使用：

当作为代码使用时，支持如下调用方式：

(org-visibility op 'src-block 'drawer …)

(org-visibility op '(src-block drawer …))

可见性切换相关的 op: 'hide, 'show, 'toggle.

3 添加新的扩展元素类型

(org-visibility 'add-type xtype1 xtype2 …)

xtype 可以是一个函数，其接口为：

(lambda (&optional ele) …)

其中 ele 为 org-element.

xtype 有两个任务：

当 ele 为 non-nil 时, xtype 将在当前 Org元素 ele
的上下文中调用，即: point 处于输入的 Org元素 ele 上。
此时, xtype 应返回一个 region 列表，以表示该 xtype
所指的元素的范围。

当 ele 为 nil 时, xtype 应返回一个符号列表，其首元素
定义该 xtype 的名称，剩余元素为 org-element types.
意在表示该 xtype 是某些 org-element types 的子节点。
比如 '(tags headline), 定义了扩展元素类型 tags, 其
层级位于 org-element headline 下。

xtype 也可以是一个符号列表，其首元素定义 xtype 名，剩
余元素为其他 xtype 或 etype 符号。如涵盖 src-block
与 tags 的扩展类型 xtype1:

'(xtype1 src-block tags)

#+end:

[Doerthous]

整体结构

#+name: 2025-07-26-20-32
#+begin_src emacs-lisp :eval no
;;; org-visibility  -*- lexical-binding: t; -*-
(!def 'org-visibility
 (!let* (org-visibility
         <<@([[id:org-visibility::private]])>>)

;;;; `org-visibility' 命令入口
  (!def org-visibility
   <<@([[id:org-visibility::org-visibility]])>>)

;;;; 隐藏元素
  (!def hide-vtypes
   <<@([[id:org-visibility::hide-vtypes]])>>)

;;;; 辅助函数
  <<@([[id:org-visibility::region-functions]])>>

;;;; 内置扩展类型
  (org-visibility
   'add-type
   <<@([[id:org-visibility::builtin-xtypes]])>>)

;;;; org-visibility End
  org-visibility))
#+end_src

内部符号

#+name: 2025-08-24-22-38
#+begin_src emacs-lisp :eval no
extend-types hide-vtypes xtype
region-hide region-show region-hidden?
vtype->etypes Xtype->vtypes Xtypes
last-choice
#+end_src

内置扩展类型

#+name: 2025-08-24-23-17
#+begin_src emacs-lisp :eval no :noweb yes
<<@([[id:org-visibility::tags-xtype]])>>
<<@([[id:org-visibility::drawer-delimiter-xtype]])>>
<<@([[id:org-visibility::sharp-line-xtype]])>>
<<@([[id:org-visibility::headline-star-xtype]])>>
<<@([[id:org-visibility::logbook-xtype]])>>
<<@([[id:org-visibility::meta&mark-xtype]])>>
#+end_src

[Doerthous]

---

入口

#+name: 2025-07-26-20-21
#+begin_src emacs-lisp :eval no
(lambda (op &rest vtypes)
  "Org visibility.

<<@([[id:org-visibility::doc:org-visibility]])>>"
  ;; 当 M-x 调用时，进入 toggle 可见性分支，
  ;; 借 `completing-read' 为用户提供备选元素。
  (interactive
   `(toggle
     ,(pcase
          (completing-read
           "Element: "
           `(,@org-element-all-elements
             ,@(mapcar
                (lambda (etype)
                  (if (listp etype) (car etype)
                    (car (funcall etype))))
                extend-types)))
        ((pred string-empty-p) last-choice)
        (c (setq last-choice (intern c))))))
  <<@([[id:org-visibility::org-visibility--Xtype-convert]])>>
  (cond
   ;; 隐藏元素
   ((eq op 'hide)
    (org-element-map
        (org-element-parse-buffer)
        (seq-uniq
         (flatten-list
          (mapcar vtype->etypes vtypes)))
      (lambda (e) (hide-vtypes e vtypes))))
   ;; 显示元素
   ((eq op 'show)
    (mapcar
     (lambda (vtype)
       (region-show
        (intern (format "org-%S" vtype))))
     vtypes))
   ;; 切换元素可见性
   ((eq op 'toggle)
    <<@([[id:org-visibility::org-visibility--toggle]])>>)
   ;; 添加新扩展元素类型
   ((eq op 'add-type)
    <<@([[id:org-visibility::org-visibility--add-type]])>>)))
#+end_src

入口之切换可见性分支

#+name: 2025-08-24-23-20
#+begin_src emacs-lisp :eval no
(let* ((hidden?
        (lambda (vtype)
          (region-hidden?
           (intern (format "org-%S" vtype)))))
       (show
        (lambda (vtype)
          (region-show
           (intern (format "org-%S" vtype)))))
       etypes)
  (if (seq-some hidden? vtypes)
      (mapcar show vtypes)
    (setq etypes (mapcar vtype->etypes vtypes))
    (setq etypes (apply #'append etypes))
    (setq etypes (seq-uniq etypes))
    (org-element-map
        (org-element-parse-buffer) etypes
      (lambda (e) (hide-vtypes e vtypes)))))
#+end_src

入口之添加扩展类型分支

每添加一个扩展类型，我们需要重构几个东西: xtype: 一个代表所有扩展类型的扩展类型; vtype->etypes: 将单个 vtype 映射为 etypes; Xtype->vtypes: 将单个 列表型xtype 映射为 vtypes.

#+name: 2025-08-24-23-21
#+begin_src emacs-lisp :eval no
(!let ((filter #'seq-filter) (map #'mapcar)
       (+ #'append) mapping Xtyps)
 (!def extend-types (+ extend-types vtypes))
 ;; 重新构造 xtype
 (!def xtype
  (map #'car
       (map #'funcall
            (filter #'functionp
                    extend-types))))
 (setf (alist-get 'xtype extend-types) xtype)
 (!def xtype `(xtype ,@xtype))
 ;; 重新构造 vtype->etypes.
 (!def mapping
  (map #'funcall
       (filter #'functionp extend-types)))
 (!def vtype->etypes
  (lambda (vt)
    (or (alist-get vt mapping) `(,vt))))
 ;; 重新构造 Xtype->vtypes.
 (!def Xtyps (filter #'listp extend-types))
 (!def Xtypes (map #'car Xtyps))
 (!def Xtype->vtypes
  (lambda (Xtype)
    (cond
     ((memq Xtype Xtypes)
      (apply
       + (map Xtype->vtypes
              (alist-get Xtype Xtyps))))
     (t `(,Xtype)))))
 nil)
#+end_src

入口之Xtype转换分支

xtype分为函数型及列表型（见文档），对于列表型xtype，于此分支中将其全转换为函数型xtype 及 etype.

#+name: 2025-08-24-23-29
#+begin_src emacs-lisp :eval no
(unless (eq op 'add-type)
  (!let ((+ (lambda (&rest S)
              (seq-reduce #'seq-union S nil)))
         (- #'seq-difference)
         (& #'seq-intersection)
         (map #'mapcar))
   (setq vtypes (flatten-list vtypes))
   ;; 将 vtypes 中的 Xtypes 转为 xtypes 或 etypes
   ;; 新 vtypes
   (!def vtypes
    (+ (- vtypes Xtypes)
       (apply + (map Xtype->vtypes
                     (& vtypes Xtypes)))))))
#+end_src

---

hide-vtypes

#+name: 2025-07-26-20-19
#+begin_src emacs-lisp :eval no
(lambda (e vtypes)
  (let ((etype (org-element-type e)))
    ;; 两个分支；一隐藏 org-element; 一隐藏扩
    ;; 展元素。
    (cond
     ;; 直接隐藏 org-element
     ((memq etype vtypes)
      (let* ((beg (org-element-begin e))
             (post-blank
              (org-element-post-blank e))
             (end (org-element-end e))
             (end (- end (or post-blank 0)))
             (type (org-element-type e))
             (type (format "org-%S" type))
             (type (intern type)))
        ;; 隐藏 drawer 或 block 时先将其展开。
        (save-excursion
          (goto-char beg)
          (ignore-errors
            (org-fold-hide-drawer-toggle
             'off)))
        (save-excursion
          (goto-char beg)
          (ignore-errors
            (org-fold-hide-block-toggle
             'off)))
        (region-hide type beg end)))
     ;; 扩展元素类型
     (t
      <<@([[id:org-visibility::hide-vtypes--xtype]])>>))))
#+end_src

hide-vtypes之隐藏扩展类型元素分支

#+name: 2025-08-24-23-31
#+begin_src emacs-lisp :eval no
(mapcar
 (lambda (xtype)
   (when-let*
       ((_ (functionp xtype))
        (types (funcall xtype))
        (_ (memq (car types) vtypes))
        (_ (memq etype types))
        (type (intern
               (format
                "org-%S" (car types))))
        (regions (funcall xtype e)))
     (mapcar
      (lambda (region)
        (region-hide
         type (car region) (cadr region)))
      regions)))
 extend-types)
#+end_src

[Doerthous]

扩展类型

由于 Org element API 只能处理特定的元素类型, 当我们想隐藏位于 heading 的 tags 时, Org element API 无该元素类型的定义。为此，org-visibility 提供了可自定义元素类型的接口，这些元素类型被称为扩展类型。

内置扩展类型: tags, drawer-delimiter, sharp-line, headline-star, logbook, meta&mark, xtype.

xtype: tags

#+name: 2025-07-26-20-22
#+begin_src emacs-lisp :eval no
(lambda (&optional ele)
  (cond
   (ele
    (save-excursion
      (save-match-data
        (goto-char (org-element-begin ele))
        (forward-line 0)
        (when (re-search-forward
               org-tag-group-re
               (line-end-position) t)
          `((;; 1+: 留一个空格编辑用
             ,(1+
               (- (point)
                  (length (match-string 0))))
             ,(point)))))))
   (t '(tags headline))))
#+end_src

xtype: drawer-delimiter

诸如 :DRAWERNAME:, :END: 之类的元素。

#+name: 2025-07-26-20-23
#+begin_src emacs-lisp :eval no
(lambda (&optional ele)
  (cond
   (ele
    (let (regions)
      (save-excursion
        (goto-char (org-element-begin ele))
        (org-fold-hide-drawer-toggle 'off)
        (push
         `(,(point) ,(1+ (line-end-position)))
         regions)

        <<@([[id:org-visibility::drawer-delimiter-xtype--end]])>>
        (nreverse regions))))
   (t '(drawer-delimiter drawer))))
#+end_src

xtype: drawer-delimiter 之 drawer-delimiter-xtype–end

#+name: 2025-08-24-23-35
#+begin_src emacs-lisp :eval no
(if (org-element-contents-end ele)
    (goto-char
     (org-element-contents-end ele))
  (forward-line))
;; :end: 隐藏时不含换行符。
(goto-char (line-end-position))
(push `(,(line-beginning-position)
        ,(min
          (+ (line-end-position)
             (if (looking-at-p "\n[^\n]")
                 0 1))
          (point-max)))
      regions)
#+end_src

xtype: sharp-line

诸如 #+begin_src, #+end_src, #+header 等 # 打头的行。

#+name: 2025-07-26-20-24
#+begin_src emacs-lisp :eval no
(lambda (&optional ele)
  (cond
   (ele
    (let* ((beg (org-element-begin ele))
           (end (org-element-end ele))
           (line "")
           (regions nil))
      (save-excursion
        (goto-char beg)
        (save-match-data
          (while (re-search-forward
                  "^#.*$" end t)
            (setq line (match-string 0))
            (save-excursion
              (ignore-errors
                (org-fold-hide-block-toggle
                 'off)))
            (goto-char (line-end-position))
            <<@([[id:org-visibility::sharp-line-xtype--add-region]])>>)))
      (nreverse regions)))
   (t '(sharp-line
        <<@([[id:org-visibility::sharp-line-xtype--parents]])>>))))
#+end_src

xtype: sharp-line 之 sharp-line-xtype–end

#+name: 2025-08-24-23-37
#+begin_src emacs-lisp :eval no
(push
 `(,(line-beginning-position)
   ,(min
     (+ (line-end-position)
        ;; 若 #+end_ 后无空行
        ;; 我们不吞其换行符。
        (if (and
             (string-match-p
              "#[+]end[:_]" line)
             (looking-at-p "\n[^\n]"))
            0 1))
     (point-max)))
 regions)
#+end_src

xtype: sharp-line 之 sharp-line-xtype–parents

#+name: 2025-08-24-23-38
#+begin_src emacs-lisp :eval no
src-block dynamic-block
comment comment-block example-block
table fixed-width keyword babel-call
#+end_src

xtype: headline-star

Org 标题前的星号。

#+name: 2025-08-24-23-40
#+begin_src emacs-lisp :eval no
(lambda (&optional ele)
  (cond
   (ele
    (save-excursion
      (save-match-data
        (goto-char (org-element-begin ele))
        (forward-line 0)
        (when (re-search-forward
               org-heading-regexp
               (line-end-position) t)
          `((,(line-beginning-position)
             ,(+
               1 (line-beginning-position)
               (length (match-string 1)))))))))
   (t '(headline-star headline))))
#+end_src

xtype: logbook

整个 LOGBOOK drawer.

#+name: 2025-08-24-23-41
#+begin_src emacs-lisp :eval no
(lambda (&optional ele)
  (cond
   (ele
    (when (member-ignore-case
           (org-element-property :drawer-name ele)
           '("LOGBOOK"))
      `((,(org-element-begin ele)
         ,(org-element-end ele)))))
   (t '(logbook drawer))))
#+end_src

xtype: meta&mark

#+name: 2025-08-24-23-42
#+begin_src emacs-lisp :eval no
'(meta&mark property-drawer timestamp logbook
            xtype)
#+end_src

[Doerthous]

辅助函数

这里，我们有试过用 overlays 实现，但用着太卡，对于拥有上千节点的 org 文件而言。

这里，我们用 char-property-alias-alist 而不直接用 invisible, 因为 org 会删改 invisible text property.

#+name: 2025-07-26-20-40
#+begin_src emacs-lisp :eval no
(!def region-hide
 (lambda (type &optional beg end)
   (cl-pushnew
    type
    (alist-get
     'invisible char-property-alias-alist))
   (cl-pushnew
    type
    (alist-get
     'read-only char-property-alias-alist))
   (with-silent-modifications
     (add-text-properties beg end `(,type t)))))
(!def region-show
 (lambda (type &optional beg end)
   (let ((prop `(,type t))
         (beg (or beg (point-min)))
         (end (or end (point-max))))
     (with-silent-modifications
       (remove-text-properties beg end prop)))))
(!def region-hidden?
 (lambda (type &optional beg end)
   (let ((beg (or beg (point-min)))
         (end (or end (point-max))))
     (text-property-any beg end type t))))
#+end_src

[Doerthous]

---

发布

此处不定时掉落最新版本，当前版本发布时间: 2025-08-25-00-03.

#+name: 2025-07-26-22-23
#+begin_src emacs-lisp :results silent :lexical t
;;; org-visibility  -*- lexical-binding: t; -*-
;;;; !let
(defmacro !let (bindings &rest body)
  (declare
   (indent
    (lambda (p s)
      (save-excursion
        (goto-char (car (last (nth 9 s))))
        (1+ (current-column))))))
  (cond
   ((null bindings) `(progn ,@body))
   (t
    (let (vars vals)
      (mapc
       (lambda (binding)
         (push (or (car-safe binding) binding) vars)
         (push (car (cdr-safe binding)) vals))
       bindings)
      `(funcall
        (lambda (,@(nreverse vars))
          (cl-macrolet
              ,(mapcar
                (lambda (s)
                  `(,s (&rest args)
                       `(funcall
                         ;;,',s
                         (or (and (functionp ,',s) ,',s)
                             (function ,',s))
                         ,@args)))
                (nreverse vars))
            ,@body))
        ,@(nreverse vals))))))

(defmacro !let* (bindings &rest body)
  (declare
   (indent
    (lambda (p s)
      (save-excursion
        (goto-char (car (last (nth 9 s))))
        (1+ (current-column))))))
  (if (null bindings) `(progn ,@body)
    (setq bindings (reverse bindings))
    (while bindings
      (setq body (list `(!let (,(pop bindings))
                         ,@body))))
    (car body)))

(defmacro !def (sym val)
  (declare
   (indent
    (lambda (p s)
      (save-excursion
        (goto-char (car (last (nth 9 s))))
        (1+ (current-column))))))
  `(!let ((val ,val))
    (if (ignore-errors
          (and ,sym (symbolp ,sym) (functionp val)))
        (defalias ,sym val)
      (setq ,sym val))))

;;; org-visibility  -*- lexical-binding: t; -*-
(!def 'org-visibility
 (!let* (org-visibility
         extend-types hide-vtypes xtype
         region-hide region-show region-hidden?
         vtype->etypes Xtype->vtypes Xtypes
         last-choice)

;;;; `org-visibility' 命令入口
  (!def org-visibility
   (lambda (op &rest vtypes)
     "Org visibility.
   
Org （元素）可见性。

几个术语：

vtype: visibility type;
etype: org element type;
xtype: extend element type;

vtype = etype + xtype.

使用：

1 作为命令使用，即 M-x org-visibility:

作为命令使用时，切换单个 vtype 的可见性。

2 作为代码使用：

当作为代码使用时，支持如下调用方式：

(org-visibility op \\='src-block \\='drawer …)

(org-visibility op \\='(src-block drawer …))

可见性切换相关的 op: \\='hide, \\='show, \\='toggle.

3 添加新的扩展元素类型

(org-visibility \\='add-type xtype1 xtype2 …)

xtype 可以是一个函数，其接口为：

(lambda (&optional ele) …)

其中 ele 为 org-element.

xtype 有两个任务：

当 ele 为 non-nil 时, xtype 将在当前 Org元素 ele
的上下文中调用，即: point 处于输入的 Org元素 ele 上。
此时, xtype 应返回一个 region 列表，以表示该 xtype
所指的元素的范围。

当 ele 为 nil 时, xtype 应返回一个符号列表，其首元素
定义该 xtype 的名称，剩余元素为 org-element types.
意在表示该 xtype 是某些 org-element types 的子节点。
比如 \\='(tags headline), 定义了扩展元素类型 tags, 其
层级位于 org-element headline 下。

xtype 也可以是一个符号列表，其首元素定义 xtype 名，剩
余元素为其他 xtype 或 etype 符号。如涵盖 src-block
与 tags 的扩展类型 xtype1:

\\='(xtype1 src-block tags)"
     ;; 当 M-x 调用时，进入 toggle 可见性分支，
     ;; 借 `completing-read' 为用户提供备选元素。
     (interactive
      `(toggle
        ,(pcase
             (completing-read
              "Element: "
              `(,@org-element-all-elements
                ,@(mapcar
                   (lambda (etype)
                     (if (listp etype) (car etype)
                       (car (funcall etype))))
                   extend-types)))
           ((pred string-empty-p) last-choice)
           (c (setq last-choice (intern c))))))
     (unless (eq op 'add-type)
       (!let ((+ (lambda (&rest S)
                   (seq-reduce #'seq-union S nil)))
              (- #'seq-difference)
              (& #'seq-intersection)
              (map #'mapcar))
        (setq vtypes (flatten-list vtypes))
        ;; 将 vtypes 中的 Xtypes 转为 xtypes 或 etypes
        ;; 新 vtypes
        (!def vtypes
         (+ (- vtypes Xtypes)
            (apply + (map Xtype->vtypes
                          (& vtypes Xtypes)))))))
     (cond
      ;; 隐藏元素
      ((eq op 'hide)
       (org-element-map
           (org-element-parse-buffer)
           (seq-uniq
            (flatten-list
             (mapcar vtype->etypes vtypes)))
         (lambda (e) (hide-vtypes e vtypes))))
      ;; 显示元素
      ((eq op 'show)
       (mapcar
        (lambda (vtype)
          (region-show
           (intern (format "org-%S" vtype))))
        vtypes))
      ;; 切换元素可见性
      ((eq op 'toggle)
       (let* ((hidden?
               (lambda (vtype)
                 (region-hidden?
                  (intern (format "org-%S" vtype)))))
              (show
               (lambda (vtype)
                 (region-show
                  (intern (format "org-%S" vtype)))))
              etypes)
         (if (seq-some hidden? vtypes)
             (mapcar show vtypes)
           (setq etypes (mapcar vtype->etypes vtypes))
           (setq etypes (apply #'append etypes))
           (setq etypes (seq-uniq etypes))
           (org-element-map
               (org-element-parse-buffer) etypes
             (lambda (e) (hide-vtypes e vtypes))))))
      ;; 添加新扩展元素类型
      ((eq op 'add-type)
       (!let ((filter #'seq-filter) (map #'mapcar)
              (+ #'append) mapping Xtyps)
        (!def extend-types (+ extend-types vtypes))
        ;; 重新构造 xtype
        (!def xtype
         (map #'car
              (map #'funcall
                   (filter #'functionp
                           extend-types))))
        (setf (alist-get 'xtype extend-types) xtype)
        (!def xtype `(xtype ,@xtype))
        ;; 重新构造 vtype->etypes.
        (!def mapping
         (map #'funcall
              (filter #'functionp extend-types)))
        (!def vtype->etypes
         (lambda (vt)
           (or (alist-get vt mapping) `(,vt))))
        ;; 重新构造 Xtype->vtypes.
        (!def Xtyps (filter #'listp extend-types))
        (!def Xtypes (map #'car Xtyps))
        (!def Xtype->vtypes
         (lambda (Xtype)
           (cond
            ((memq Xtype Xtypes)
             (apply
              + (map Xtype->vtypes
                     (alist-get Xtype Xtyps))))
            (t `(,Xtype)))))
        nil)))))

;;;; 隐藏元素
  (!def hide-vtypes
   (lambda (e vtypes)
     (let ((etype (org-element-type e)))
       ;; 两个分支；一隐藏 org-element; 一隐藏扩
       ;; 展元素。
       (cond
        ;; 直接隐藏 org-element
        ((memq etype vtypes)
         (let* ((beg (org-element-begin e))
                (post-blank
                 (org-element-post-blank e))
                (end (org-element-end e))
                (end (- end (or post-blank 0)))
                (type (org-element-type e))
                (type (format "org-%S" type))
                (type (intern type)))
           ;; 隐藏 drawer 或 block 时先将其展开。
           (save-excursion
             (goto-char beg)
             (ignore-errors
               (org-fold-hide-drawer-toggle
                'off)))
           (save-excursion
             (goto-char beg)
             (ignore-errors
               (org-fold-hide-block-toggle
                'off)))
           (region-hide type beg end)))
        ;; 扩展元素类型
        (t
         (mapcar
          (lambda (xtype)
            (when-let*
                ((_ (functionp xtype))
                 (types (funcall xtype))
                 (_ (memq (car types) vtypes))
                 (_ (memq etype types))
                 (type (intern
                        (format
                         "org-%S" (car types))))
                 (regions (funcall xtype e)))
              (mapcar
               (lambda (region)
                 (region-hide
                  type (car region) (cadr region)))
               regions)))
          extend-types))))))

;;;; 辅助函数
  (!def region-hide
   (lambda (type &optional beg end)
     (cl-pushnew
      type
      (alist-get
       'invisible char-property-alias-alist))
     (cl-pushnew
      type
      (alist-get
       'read-only char-property-alias-alist))
     (with-silent-modifications
       (add-text-properties beg end `(,type t)))))
  (!def region-show
   (lambda (type &optional beg end)
     (let ((prop `(,type t))
           (beg (or beg (point-min)))
           (end (or end (point-max))))
       (with-silent-modifications
         (remove-text-properties beg end prop)))))
  (!def region-hidden?
   (lambda (type &optional beg end)
     (let ((beg (or beg (point-min)))
           (end (or end (point-max))))
       (text-property-any beg end type t))))

;;;; 内置扩展类型
  (org-visibility
   'add-type
   (lambda (&optional ele)
     (cond
      (ele
       (save-excursion
         (save-match-data
           (goto-char (org-element-begin ele))
           (forward-line 0)
           (when (re-search-forward
                  org-tag-group-re
                  (line-end-position) t)
             `((;; 1+: 留一个空格编辑用
                ,(1+
                  (- (point)
                     (length (match-string 0))))
                ,(point)))))))
      (t '(tags headline))))
   (lambda (&optional ele)
     (cond
      (ele
       (let (regions)
         (save-excursion
           (goto-char (org-element-begin ele))
           (org-fold-hide-drawer-toggle 'off)
           (push
            `(,(point) ,(1+ (line-end-position)))
            regions)
   
           (if (org-element-contents-end ele)
               (goto-char
                (org-element-contents-end ele))
             (forward-line))
           ;; :end: 隐藏时不含换行符。
           (goto-char (line-end-position))
           (push `(,(line-beginning-position)
                   ,(min
                     (+ (line-end-position)
                        (if (looking-at-p "\n[^\n]")
                            0 1))
                     (point-max)))
                 regions)
           (nreverse regions))))
      (t '(drawer-delimiter drawer))))
   (lambda (&optional ele)
     (cond
      (ele
       (let* ((beg (org-element-begin ele))
              (end (org-element-end ele))
              (line "")
              (regions nil))
         (save-excursion
           (goto-char beg)
           (save-match-data
             (while (re-search-forward
                     "^#.*$" end t)
               (setq line (match-string 0))
               (save-excursion
                 (ignore-errors
                   (org-fold-hide-block-toggle
                    'off)))
               (goto-char (line-end-position))
               (push
                `(,(line-beginning-position)
                  ,(min
                    (+ (line-end-position)
                       ;; 若 #+end_ 后无空行
                       ;; 我们不吞其换行符。
                       (if (and
                            (string-match-p
                             "#[+]end[:_]" line)
                            (looking-at-p "\n[^\n]"))
                           0 1))
                    (point-max)))
                regions))))
         (nreverse regions)))
      (t '(sharp-line
           src-block dynamic-block
           comment comment-block example-block
           table fixed-width keyword babel-call))))
   (lambda (&optional ele)
     (cond
      (ele
       (save-excursion
         (save-match-data
           (goto-char (org-element-begin ele))
           (forward-line 0)
           (when (re-search-forward
                  org-heading-regexp
                  (line-end-position) t)
             `((,(line-beginning-position)
                ,(+
                  1 (line-beginning-position)
                  (length (match-string 1)))))))))
      (t '(headline-star headline))))
   (lambda (&optional ele)
     (cond
      (ele
       (when (member-ignore-case
              (org-element-property :drawer-name ele)
              '("LOGBOOK"))
         `((,(org-element-begin ele)
            ,(org-element-end ele)))))
      (t '(logbook drawer))))
   '(meta&mark property-drawer timestamp logbook
               xtype))

;;;; org-visibility End
  org-visibility))
#+end_src

[Doerthous]

[Doerthous]