Add features of leading stars with text properties & reverse outline path for consult-org-heading

[IceAsteroid]

I managed to implement it to barely work, but it needs some improvements.

For someone new here, Here's where is the feature proposal that I mentioned: #862 It explains why these features are useful for.

Features:

• Added a custom boolean variable consult-org-heading-add-leading-stars to set if to display leading stars of a condidate or not & corresponding implementation.
• Added a custom boolean variable consult-org-heading-reverse-path to set if to reverse order of outline path of a candidate or not & corresponding implementation.

Some problems that I encountered(I need some help!):

I found no way to do:

• Prevent the heading local variable to be set when both "reverse outline" & "leading stars" features are not required(their custom variables are set to nil)
• Prevent the leading-stars local variable to be set when "leading stars" feature is not required(it's custom variables are set to nil)

If setting the local variables as nil rather than not defining them, then it's doable, but I'm not sure if that's the right way.

• A glitch that when complementing the full text(by Tab) for the selected candidate, the sub-heading candidates won't be matched, which I don't know why. it needs to backspace once in order to display sub-heading candidates normally.
• Another glitch: if there's any comma included when completing a candidate that contains comma, the sub-headings won't be matched.

Here's the code:

(defcustom org-outline-path-separator "/"
  "Separator used to delimit ancestors of an outline path in org-mode"
  :type 'string)

(defun org-outline-path-reverse (path &optional separator)
  "Reverse the order of outline path.

PATH is an outline path.
SEPARATOR is to delimit each ancestor, by default, it’s \"/\""
  (let ((separator (or separator "/")))
    (string-join
     (reverse
      (split-string
       path
       separator))
     separator)))

(defcustom consult-org-heading-reverse-path t
  "When non-nil, reverse the order of outline path by displaying current heading first, following its ancestors"
  :type 'boolean)

(defcustom consult-org-heading-add-leading-stars t
  "When non-nil, leading stars that indicate levels are added to candidates"
  :type 'boolean)

(defun consult-org--headings (prefix match scope &rest skip)
  "Return a list of Org heading candidates.

If PREFIX is non-nil, prefix the candidates with the buffer name.
MATCH, SCOPE and SKIP are as in `org-map-entries'."
  (let ((buffer)
	(idx 0))
    (apply
     #'org-map-entries
     (lambda ()
       ;; Reset the cache when the buffer changes, since `org-get-outline-path' uses the cache
       (unless (eq buffer (buffer-name))
         (setq buffer (buffer-name)
               org-outline-path-cache nil))
       (pcase-let* ((`(_ ,level ,todo ,prio ,_hl ,tags) (org-heading-components))
                    (tags (if org-use-tag-inheritance
                              (when-let ((tags (org-get-tags)))
                                (concat ":" (string-join tags ":") ":"))
                            tags))
		    (heading (buffer-substring (point-at-bol) (point-at-eol)))
		    (leading-stars (progn
				     (string-match "^\*+ " heading)
				     (match-string 0 heading)))
                    ;; (cand (org-format-outline-path
                    ;;        (org-get-outline-path 'with-self 'use-cache)
                    ;;        most-positive-fixnum)))
		    (cand
		     (concat
		      ;; Add leading stars & text properties perserved
		      (when consult-org-heading-add-leading-stars
			leading-stars)
		      (if consult-org-heading-reverse-path
			  ;; Reverse order of outline path
			  (org-outline-path-reverse
	       		   (org-format-outline-path
			    (org-get-outline-path 'with-self 'use-cache)
			    most-positive-fixnum
			    nil
			    org-outline-path-separator)
			   org-outline-path-separator)
			(org-format-outline-path
                         (org-get-outline-path 'with-self 'use-cache)
                         most-positive-fixnum)))))

         (when todo
           (put-text-property 0 (length todo) 'face (org-get-todo-face todo) todo))
         (when tags
           (put-text-property 0 (length tags) 'face 'org-tag tags))
         (setq cand (concat (and prefix buffer) (and prefix " ") cand (and tags " ")
                            tags (consult--tofu-encode idx)))
         (cl-incf idx)
         (add-text-properties 0 1
                              `(org-marker ,(point-marker)
                                consult-org--heading (,level ,todo ,prio . ,buffer))
                              cand)
         cand))
     match scope skip)))

[IceAsteroid]

Hi, @minad, good day!

All other problems are minor, but here's a problem when commas that a heading candidate including them, will cause its sub-heading condidates not being able to be matched.

The problem also occurs when using the original code.

Here's the demo:

consult-org-heading-discussion-comma-problem.mp4

[oantolin]

Are you using orderless with the default configuration? It uses comma to indicate you want a term to match as an initialism, so topic, matches tantalizing otherworldly portal inexplicably created but does not match the word topic itself. See the orderless manual for the full list of special syntax in the default configuration.

[IceAsteroid]

Thanks for the help, and sorry for the ugly code.

That was indeed the cause by orderless.

Except the comma, it also makes me realize that the leading stars should be presented like line numbers and not be completed, as shown in consult-outline. Otherwise, when not using Orderless, the completion of a heading candidate doesn't match the sub-heading candidates, because leading stars of the selected candidate are not part of the sub-heading candidate's ancestor

[IceAsteroid]

The following configuration solved the problem, I just removed all the dispatchers that would use some symbols as special characters. Since there's no specific need for me to use dispatchers in consult-org-heading. If someone has a need for dispatchers, just change the affix character codes to not be conflicted with the headings.

(defun my-fix/consult-org-heading-with-orderless ()
  "Modify orderless’ default configuration when `consult-org-heading’ is invoked, to resolve conflicts when completion, such as the comma is not treated as a plain character."
  (with-eval-after-load 'consult-org
    (with-eval-after-load 'orderless
      (defvar consult-org-orderless-affix-dispatch-alist nil
	"An alist that would replace the values of `orderless-affix-dispatch-alist when `consult-org-heading’ is invoked.")

      ;; Default values of `orderless-affix-dispatch-alist’
      ;; (setq consult-org-heading-orderless-affix-dispatch-alist
      ;; 	    `((?% . ,#'char-fold-to-regexp)
      ;; 	      (?! . ,#'orderless-not)
      ;; 	      (?& . ,#'orderless-annotation)
      ;; 	      (?, . ,#'orderless-initialism)
      ;; 	      (?= . ,#'orderless-literal)
      ;; 	      (?^ . ,#'orderless-literal-prefix)
      ;; 	      (?~ . ,#'orderless-flex)))

      (setq consult-org-heading-orderless-affix-dispatch-alist '(nil))

      (defun my/consult-org-heading-with-orderless (orig-func &rest args)
	(interactive)
	(let ((orderless-affix-dispatch-alist (or consult-org-heading-orderless-affix-dispatch-alist orderless-affix-dispatch-alist)))
	  (apply orig-func (list args))))
      (advice-add 'consult-org-heading :around #'my/consult-org-heading-with-orderless))))
(my-fix/consult-org-heading-with-orderless)

[minad]

Thanks. Regarding the candidate string generation I hope we can avoid obtaining the headline path, splitting it, and putting it together again. The concatenation should only be done once to avoid significant overhead.

[IceAsteroid]

Updated, would this one be better?

;;		    (heading (buffer-substring (point-at-bol) (point-at-eol)))
;;		    (leading-stars (progn
;;				     (string-match "^\*+ " heading)
;;				     (match-string 0 heading)))

			(leading-stars
			 (let ((line (thing-at-point 'line nil)))
			   (when (string-match "^\\*+ " line)
			     (match-string 0 line))))

I was planning to also implement the overlay support, so I made the additional heading variable there, but now it seems a bit unnecessary.

[IceAsteroid]

Except the comma, it also makes me realize that the leading stars should be presented like line numbers and not be completed, as shown in consult-outline. Otherwise, when not using Orderless, the completion of a heading candidate doesn't match the sub-heading candidates, because leading stars of the selected candidate are not part of the sub-heading candidate's ancestor

I have refactored the code and have the aforementioned feature implemented.

---

The "leading stars" thing was put in a text property of the candidate in the consult-org--heading instead of concatenating it directly in the candidate.

An annotation function was defined called consult-org-heading--leading-stars that receives the candidate as an argument and then retrieves the leading-stars(properties reserved), and finally returns the leading-stars as prefix, the candidate, and the empty suffix string.

Finally the function was specified in the :annotate keyword of consult--read within the consult-org-heading command.

---

Thanks for the well-designed code structure, so that made this possible.

I'll post the code here, when I revise it again. :)

Here's the demo:

consult-org-heading-stars-discussion2.mp4

---

However, I'm not sure putting the "leading stars" in the candidate's properties is a sane method or not.

[IceAsteroid]

Here's the complete version of the implementation, I've used it a couple of weeks, and it just works, just to share here, someone may find it interesting and improve it to be more generic so that can be added to the repo's wiki. Since I actually got no much confidence in my code quality.

• The first part is org-subentry-count(), which displays a counting number in a heading for the number of its sub-headings.

• The second part is for displaying the ancestor headings in reverse order for each heading, so each heading itself can be displayed at the beginning first to not be truncated at the edge for small screen besides its ancestor headings.

• The rest parts at the bottom are for some fixes for the implementation.

The first part:

;; Org mode self-defined features
;; Implement subentry count in title for each heading
;;-This implementation was created as barely a scratch by me
;;-, but was improved to perfection by @dalanicolai on StackExchange.
;;- https://emacs.stackexchange.com/questions/79785/how-to-display-sub-heading-count-somewhere-in-a-heading-in-org-mode/79829?noredirect=1#comment133905_79829
(defun my-deploy/org-subentry-count ()
  "A feature to display count in a heading to indicate number of its subheadings."
  (defcustom org-subentry-count-at-start nil
    "Show the subentry count before the title, not after."
    :group 'org-subenty-count
    :type 'boolean)
  (defvar org-subentry-count-in-headings-p nil
    "t to enable org-subentry-count-in-headings
       nil to disable org-subentry-count-in-headings")
  (defface subentry-count-1 nil
    "org-level-1")
  (defface subentry-count-2 nil
    "org-level-2")
  (defface subentry-count-3 nil
    "org-level-3")
  (defface subentry-count-4 nil
    "org-level-4")
  (defface subentry-count-5 nil
    "org-level-5")
  (defface subentry-count-6 nil
    "org-level-6")
  (defface subentry-count-7 nil
    "org-level-7")
  (defface subentry-count-8 nil
    "org-level-8")

  (dotimes (count 9)
    (when (< 0 count)
      (set-face-attribute
       (intern (concat "subentry-count-" (number-to-string count)))
       nil
       :inherit (intern (concat "org-level-" (number-to-string count)))
       :font (face-attribute 'variable-pitch :family)
       :height 'unspecified
       :weight 'unspecified
       )))

  (defun org-subentry-count-in-headings ()
    (org-map-entries
     (lambda ()
       (when (looking-at org-complex-heading-regexp)
         (let* ((group (if org-subentry-count-at-start 1 0))
                (beg (match-beginning group))
                (end (match-end group))
                (level (length (match-string 1))) ;; Stars in headline
                (subheading-count (format "%s" (1- (length (org-map-entries nil nil 'tree)))))
                (ov (car (seq-filter
                          ;; Search for subentry-count overlay
                          (lambda (o)
                            (eq (overlay-get o 'type) 'subentry-count))
                          (overlays-in (line-beginning-position)
                                       (line-end-position))))))
           (if ov ;; Only create overlay if not exists yet
               (move-overlay ov beg end)
             (setq ov (make-overlay beg end))
             (overlay-put ov 'type 'subentry-count) ;; Add a type, for easy filtering
             (overlay-put ov 'evaporate t))
           ;; Only add/remove 'after-string' prop in toggle
           (if org-subentry-count-in-headings-p
               ;; Original lines to set `after-string’ & its properties.
               ;; (overlay-put
               ;;  ov
               ;;  'after-string
               ;;  (propertize (format " [%s]" subheading-count)
               ;;              'face (intern-soft (format "org-level-%d" level))))

               ;; Workaround using `faces’ instead of `display’ for
               ;; performance-wise, `display’ is too laggy Using `faces’ that
               ;; doesn’t have `:height’ specified or inherited will fix the
               ;; double-sized ,overlay of the org-headings when org-headings
               ;; are set with larger height than 1.0.
               (overlay-put
                ov
                'after-string
                (propertize (format " [%s]" subheading-count)
                            'face (intern-soft (format "subentry-count-%d" level))))
             (overlay-put ov 'after-string nil))))))
    'file
    )

  (defun my/toggle-org-subentry-count-in-headings ()
    (interactive)
    (if org-subentry-count-in-headings-p
        (setq org-subentry-count-in-headings-p nil)
      (setq org-subentry-count-in-headings-p t))
    (org-subentry-count-in-headings))
  (defun my/toggle-org-subentry-position ()
    (interactive)
    (setq org-subentry-count-at-start (not org-subentry-count-at-start))
    (setq org-subentry-count-in-headings-p t)
    (org-subentry-count-in-headings))
  (add-hook 'org-mode-hook
            (lambda ()
              (setq org-subentry-count-in-headings-p t)
              (setq org-subentry-count-at-start t)
              (org-subentry-count-in-headings)
              ;; (add-hook 'after-save-hook 'org-subentry-count-in-headings)
              (add-hook 'after-save-hook 'org-subentry-count-in-headings nil t)
              ))
  )
(my-deploy/org-subentry-count)

The second part:

(defun my-deploy/consult-org-heading-modified-reverse-outline ()
  (with-eval-after-load 'consult-org
    ;; The "·" symbol is Greek Ano Teleia (U+0387)
    (defcustom consult-org-outline-path-separator "·"
      "Separator used to delimit ancestor of an outline path in org-mode"
      :type 'string)

    (defun consult-org-outline-path-reverse (path &optional separator)
      "Reverse the order of outline path.

PATH is an outline path.
SEPARATOR is to delimit each ancestor, by default, it’s \"/\""
      (let ((separator (or separator "/")))
        (string-join
         (reverse
          (split-string
           path
           separator))
         separator)))

    (defcustom consult-org-heading-reverse-path t
      "When non-nil, reverse the order of outline path by displaying current
 heading first, following its ancestors"
      :type 'boolean)

    (defun consult-org--headings (prefix match scope &rest skip)
      "Return a list of Org heading candidates.

If PREFIX is non-nil, prefix the candidates with the buffer name.
MATCH, SCOPE and SKIP are as in `org-map-entries'."
      (let ((buffer)
            (idx 0))
        (apply
         #'org-map-entries
         (lambda ()
           ;; Reset the cache when the buffer changes, since `org-get-outline-path' uses the cache
           (unless (eq buffer (buffer-name))
             (setq buffer (buffer-name)
                   org-outline-path-cache nil))

           ;;Some leading stars of headings are not fontified when
           ;;`org-map-entries’ on a heading, make sure they’re fontified before
           ;;retrieving data from it. It’s probably set fontified on demand,
           ;;which means org buffer working fine but not for commands like
           ;;`org-map-entries’. See more details on `consult-outline’ & in the
           ;;definitions of `consult--fontify-region’ & `jit-locl-mode’.
           ;; From Emacs Manual:
           ;; Fontifying very large buffers can take a long time.  To avoid
           ;; large delays when a file is visited, Emacs initially fontifies
           ;; only the visible portion of a buffer.  As you scroll through the
           ;; buffer, each portion that becomes visible is fontified as soon as
           ;; it is displayed; this type of Font Lock is called “Just-In-Time”
           ;; (or “JIT”) Lock.  You can control how JIT Lock behaves, including
           ;; telling it to perform fontification while idle, by customizing
           ;; variables in the customization group ‘jit-lock’.  *Note Specific
           ;; Customization::.
           (consult--fontify-region (pos-bol) (pos-eol))

           (pcase-let* ((`(_ ,level ,todo ,prio ,_hl ,tags) (org-heading-components))
                        (tags (if org-use-tag-inheritance
                                  (when-let ((tags (org-get-tags)))
                                    (concat ":" (string-join tags ":") ":"))
                                tags))
                        ;; (stars
                        ;;  (let ((line (thing-at-point 'line nil)))
                        ;;    (when (string-match "^\\*+" line)
                        ;;      (match-string 0 line))))
                        (stars
                         (when (org-match-line "^\\**")
                           (match-string 0)))

                        (subentry-count
                         (when-let*
                             ((overlay
                               (car
                                (seq-filter
                                 ;; search for subentry-count overlay
                                 (lambda (o)
                                   (eq (overlay-get o 'type) 'subentry-count))
                                 (overlays-in (line-beginning-position)
                                              (line-end-position)))))
                              (count (overlay-get overlay 'after-string))
                              )
                           ;; Prevent to run & return nil if overlay not exists
                           ;;,otherwise errors would occur.
                           ;;‘(overlay-get overlay 'after-string)’ may return nil
                           ;;,if turn off subentry-count via
                           ;;,`my/toggle-org-subentry-count-in-headings’
                           ;;,but the overlay still exists, is just empty
                           ;;, so another test as the ‘count’ variable is needed.
                           (string-trim (overlay-get overlay 'after-string))))

                        ;; Original code for generating outline for candidate
                        ;; (cand (org-format-outline-path
                        ;;        (org-get-outline-path 'with-self 'use-cache)
                        ;;        most-positive-fixnum)))

                        (cand
                         (if consult-org-heading-reverse-path
                             ;; Reverse order of outline path
                             (consult-org-outline-path-reverse
                              (org-format-outline-path
                               (org-get-outline-path 'with-self 'use-cache)
                               most-positive-fixnum
                               nil
                               consult-org-outline-path-separator)
                              consult-org-outline-path-separator)
                           ;; Remain original order if condition is nil
                           (org-format-outline-path
                            (org-get-outline-path 'with-self 'use-cache)
                            most-positive-fixnum)))
                        )

             (when todo
               (put-text-property 0 (length todo) 'face (org-get-todo-face todo) todo))
             (when tags
               (put-text-property 0 (length tags) 'face 'org-tag tags))

             ;; (setq cand (concat (and prefix buffer) (and prefix " ") cand (and tags " ")
             ;;                         tags (consult--tofu-encode idx)))

             ;; (setq cand (concat (and prefix buffer)
             ;;                           (and prefix " ")
             ;;                           cand
             ;;                           (and tags " ")
             ;;                           tags))

             ;; (put-text-property
             ;;  0 1
             ;;  'trail-symbols
             ;;  (concat (and prefix buffer)
             ;;               (and prefix " ")
             ;;               cand
             ;;               (and tags " ")
             ;;               tags)
             ;;  cand)
             (setq lead-symbols
                   (concat (and prefix buffer)
                           (and prefix " ")))
             (setq trail-symbols
                   (concat (and tags " ")
                           tags))

             (cl-incf idx)
             (add-text-properties
              0 1
              `(org-marker ,(point-marker)
                           consult-org--heading (,level ,todo ,prio . ,buffer))
              cand)
             ;; Add leading stars in the standalone property instead of ’consult-org--heading
             ;;,to prevent Prefix narrowings like for TODO or Done failure.
             (add-text-properties
              0 1
              `(affix-marker ,(point-marker)
                             consult-org--affixes (,stars ,lead-symbols ,trail-symbols ,subentry-count . ,buffer))
              cand)

             ;; (when stars
             ;;   (put-text-property 0 1 'leading-stars stars cand))
             ;; (when subentry-count
             ;;   (put-text-property 0 1 'subentry-count subentry-count cand))

             cand))
         match scope skip)))

    (defcustom consult-org-add-stars t
      "Toggle the display of leading stars of `consult-org--annotate’ or `consult-org--annotate-prefix’,
for candidates in `consult-org-heading’.

nil to turn off. non-nil to turn on."
      :type 'boolean)

    (defcustom consult-org-add-todo t
      "Toggle the display of todo keyword of `consult-org--annotate’ or `consult-org--annotate-prefix’,
for candidates in `consult-org-heading’.

nil to turn off. non-nil to turn on."
      :type 'boolean)

    (defcustom consult-org-add-prio t
      "Toggle the display of priority keyword of `consult-org--annotate’ or `consult-org--annotate-prefix’,
for candidates in `consult-org-heading’.

nil to turn off. non-nil to turn on."
      :type 'boolean)

    (defcustom consult-org-add-subentry-count t
      "Toggle the display of the self-defined `subentry-count’ features’ overlay of `consult-org--annotate’ or `consult-org--annotate-prefix’,
for candidates in `consult-org-heading’.

nil to turn off. non-nil to turn on."
      :type 'boolean)

    (defun consult-org--annotate-prefix (cand)
      "Prefix version of `consult-org--annotate’, that displays annotation elements
before candidates.  It includes an extra feature to display ’leading-stars’ with
property preserved.  Annotate `consult-location' candidates with line numbers
for Org headings.  CURR-LINE is the current line number."
      (pcase-let* ((`(,_level ,todo ,prio . ,_)
                    (get-text-property 0 'consult-org--heading cand))
                   (`(,stars ,lead-symbols ,trail-symbols ,subentry-count . ,_)
                    (get-text-property 0 'consult-org--affixes cand)))

        ;; Unify height sizes here for prefixes, candidate and suffixes
        ;; Deliver cand’s buffer & tag from within text properties
        ;;,of cand, instead of the original way to concate into cand
        ;;,to prevent height being overrided by the following propertization
        ;;,and have their own heights here.
        ;; [TODO] If possible, replace to use `face’ instead `display’
        ;;,for performance-wise, `display’s too laggy.
        (list
         (concat
          (propertize lead-symbols 'display '(height 0.7))
          (propertize cand 'display '(height 1.0))
          (propertize trail-symbols 'display '(height 0.7)))
         ;; Propertize all prefixes in height 1.0, particularly make stars
         ;;,smaller in height since org-superstar’s increasing line height
         (concat (propertize (and consult-org-add-stars stars)
                             'display '(height 1.0))
                 (propertize
                  (concat (and consult-org-add-subentry-count subentry-count)
                          (and consult-org-add-todo todo)
                          (and consult-org-add-prio
                               prio
                               (format #("[#%c]" 0 5 (face org-priority)) prio)))
                  'display '(height 1.0)))
         ;; propertize all prefixes in this case, empty string in height 0.1
         (propertize "" 'display '(height 1.0))
         ))
      )

    (consult-customize
     consult-org-heading
     ;; :annotate #'consult-org--annotate
     :annotate #'consult-org--annotate-prefix
     )
    ))
(my-deploy/consult-org-heading-modified-reverse-outline)

A fix for a bug of org-map-entries which displays errors about agenda file doesn't exist while no access to agenda files, in relevance of the implementation:

Note: This may have been fixed if you're using the latest org-mode version, so you don't have to use the code below, only if you encounter such similar issues, then just try to use it.

;; Trying to fix the org-agenda-files error
;; Advice-Patch
;; if #'org-map-entries is called then #'org-check-agenda-file is executed through #'org-agenda-prepare-buffers
;; issue: neither functions is relevant to non-agenda files, causes bug asking user for extra input
;; Non-existent agenda file %s.  [R]emove from list or [A]bort?
;; see : https://github.com/bzg/org-mode/blob/ec5d76bce1434a54a9a529dbe250b09dc3c132c0/lisp/org.el#L15340
;; Possible solution: Do not call #'org-agenda-prepare-buffers for non-agenda files => ~exist 'org-agenda-files
(defun my-fix/org-map-entries-agenda ()
  "Fix `org-map-entries’ to cause to misopen agenda when it’s not existent."
  (defun my-org-agenda-prepare-buffers-advice (orig-func &rest args)
    "Advice function to modify `org-agenda-prepare-buffers'.
It filters the FILES argument to ensure only agenda files are processed."
    (let ((files (if (listp (car args)) (car args) nil)))
      (when files
        (setq files (seq-filter #'(lambda (file) (member file org-agenda-files)) files)))
      (apply orig-func (list files))))

  (advice-add 'org-agenda-prepare-buffers :around #'my-org-agenda-prepare-buffers-advice))
(my-fix/org-map-entries-agenda)

Disable orderless to prevent mismatching for special characters specified in headings, so consult-org-heading can just search user input for those characters as plain text.

(defun my-fix/consult-org-heading-with-orderless ()
  "Modify orderless’ default configuration when
 `consult-org-heading’ is invoked, to resolve conflicts when completion, such as
 the comma is not treated as a plain character."
  (with-eval-after-load 'consult-org
    (with-eval-after-load 'orderless
      (defvar consult-org-orderless-affix-dispatch-alist nil
        "An alist that would replace the values of
 `orderless-affix-dispatch-alist when `consult-org-heading’ is invoked.")

      ;; Default values of `orderless-affix-dispatch-alist’
      ;; (setq consult-org-heading-orderless-affix-dispatch-alist
      ;;            `((?% . ,#'char-fold-to-regexp)
      ;;              (?! . ,#'orderless-not)
      ;;              (?& . ,#'orderless-annotation)
      ;;              (?, . ,#'orderless-initialism)
      ;;              (?= . ,#'orderless-literal)
      ;;              (?^ . ,#'orderless-literal-prefix)
      ;;              (?~ . ,#'orderless-flex)))

      (setq consult-org-heading-orderless-affix-dispatch-alist '(nil))

      (defun my/consult-org-heading-with-orderless (orig-func &rest args)
        (interactive)
        (let ((orderless-affix-dispatch-alist (or consult-org-heading-orderless-affix-dispatch-alist orderless-affix-dispatch-alist)))
          (apply orig-func (list args))))
      (advice-add 'consult-org-heading :around #'my/consult-org-heading-with-orderless))))
(my-fix/consult-org-heading-with-orderless)

Note that if you specify a subheading with unmatched heading level to its father heading, for example, the father is first level heading, and a subheading direct to it is third level heading, the font-lock color for the sub-heading will be displayed improperly, this is a historic problem in org-mode, here's the post in org-mode bug tracker: https://lists.gnu.org/archive/html/emacs-orgmode/2024-10/msg00207.html

That's pretty much it. Lately I'll post a demo video, it's actually quite nice, my dream actually has come true to have a fully note-taking system in Emacs without a mouse!

If someone trying to use the code and has questions, please just ask, I may have something necessary neglected to post for the code.