1 ;;; element-debug-mode by Nicolas, see:
3 ;; (notmuch-show "id:87d21dsvox.fsf@nicolasgoaziou.fr")
4 ;; <http://mid.gmane.org/87d21dsvox.fsf@nicolasgoaziou.fr>
6 ;; (notmuch-show "id:87ioaqsaz2.fsf@nicolasgoaziou.fr")
7 ;; <http://mid.gmane.org/87ioaqsaz2.fsf@nicolasgoaziou.fr>
9 (defun element-check-cache (&rest ignore)
10 (when (org-element--cache-active-p)
12 (let ((cache (copy-tree org-element--cache t))
13 (requests (copy-tree org-element--cache-sync-requests t))
14 (buffer-contents (org-with-wide-buffer (buffer-string)))
15 (translations (make-hash-table :test #'eq))
16 (structures (make-hash-table :test #'eq))
17 (keys (make-hash-table :test #'eq)))
19 (loop for key in (avl-tree-flatten org-element--cache)
20 for value in (avl-tree-flatten cache)
21 do (let ((struct (and (memq (org-element-type key)
23 (gethash (org-element-property :structure key)
24 structures 'missing))))
26 (puthash key value translations)
27 (let ((k (gethash key org-element--cache-sync-keys)))
28 (when k (puthash value k keys)))
31 (org-element-put-property
33 (gethash (org-element-property :parent key)
36 (when (eq struct 'missing)
38 (puthash (org-element-property :structure key)
39 (org-element-property :structure value)
44 (org-element-put-property value :structure struct)
47 (loop for original in org-element--cache-sync-requests
49 do (aset copy 4 (gethash (aref original 4) translations)))
51 (let ((org-element-use-cache nil)) (insert buffer-contents))
52 (let ((org-inhibit-startup t)) (org-mode))
53 (setq org-element--cache cache
54 org-element--cache-sync-requests requests
55 org-element--cache-sync-keys keys)
56 (org-element--cache-sync (current-buffer) (point-max))
60 (let ((beg (org-element-property :begin element))
61 (type (org-element-type element)))
62 (let ((real (let (org-element-use-cache)
64 (if (memq type '(item table-row)) (1+ beg)
66 (org-element-at-point))))
70 "======\nWARNING. Two entries for the same element\n\n %s"
72 ((not (equal real element))
74 "======\nWARNING. Corrupted element (%s) at %d\n\nReal:\
75 %s\n\nCached: %s\n\nLast request: %s"
76 (org-element-type element) beg real element (car requests)))
77 (t (push real seen))))))
78 org-element--cache)))))))
80 (define-minor-mode element-debug-mode
81 "Minor mode to debug Org Element cache."
83 (if element-debug-mode
84 (progn (setq org-element-cache-sync-idle-time 3600)
85 (add-hook 'after-change-functions 'element-check-cache t t))
86 (setq org-element-cache-sync-idle-time 0.6)
87 (remove-hook 'after-change-functions 'element-check-cache t)))
89 (provide 'org-element-debug)