X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=emacs_el%2Forg-element-debug.el;fp=emacs_el%2Forg-element-debug.el;h=0000000000000000000000000000000000000000;hb=1cb83c61e9093f3aa806f47c2d390035d66a29ea;hp=8de62ad415e381494e90219b34f79948d75b2a8a;hpb=794cf3ff5bc1f03cfebe7ba16a37a6b5757a2ad9;p=lib.git

diff --git a/emacs_el/org-element-debug.el b/emacs_el/org-element-debug.el
deleted file mode 100644
index 8de62ad..0000000
--- a/emacs_el/org-element-debug.el
+++ /dev/null
@@ -1,89 +0,0 @@
-;;; element-debug-mode by Nicolas, see:
-;;
-;; (notmuch-show "id:87d21dsvox.fsf@nicolasgoaziou.fr")
-;; <http://mid.gmane.org/87d21dsvox.fsf@nicolasgoaziou.fr>
-;;
-;; (notmuch-show "id:87ioaqsaz2.fsf@nicolasgoaziou.fr")
-;; <http://mid.gmane.org/87ioaqsaz2.fsf@nicolasgoaziou.fr>
-
-(defun element-check-cache (&rest ignore)
-  (when (org-element--cache-active-p)
-    (save-match-data
-      (let ((cache (copy-tree org-element--cache t))
-	    (requests (copy-tree org-element--cache-sync-requests t))
-	    (buffer-contents (org-with-wide-buffer (buffer-string)))
-	    (translations (make-hash-table :test #'eq))
-	    (structures (make-hash-table :test #'eq))
-	    (keys (make-hash-table :test #'eq)))
-	;; Fix parents.
-	(loop for key in (avl-tree-flatten org-element--cache)
-	      for value in (avl-tree-flatten cache)
-	      do (let ((struct (and (memq (org-element-type key)
-					  '(plain-list item))
-				    (gethash (org-element-property :structure key)
-					     structures 'missing))))
-		   (progn
-		     (puthash key value translations)
-		     (let ((k (gethash key org-element--cache-sync-keys)))
-		       (when k (puthash value k keys)))
-		     (puthash
-		      key
-		      (org-element-put-property
-		       value :parent
-		       (gethash (org-element-property :parent key)
-				translations))
-		      translations)
-		     (when (eq struct 'missing)
-		       (setq struct
-			     (puthash (org-element-property :structure key)
-				      (org-element-property :structure value)
-				      structures)))
-		     (when struct
-		       (puthash
-			key
-			(org-element-put-property value :structure struct)
-			translations)))))
-	;; Fix requests.
-	(loop for original in org-element--cache-sync-requests
-	      for copy in requests
-	      do (aset copy 4 (gethash (aref original 4) translations)))
-	(with-temp-buffer
-	  (let ((org-element-use-cache nil)) (insert buffer-contents))
-	  (let ((org-inhibit-startup t)) (org-mode))
-	  (setq org-element--cache cache
-		org-element--cache-sync-requests requests
-		org-element--cache-sync-keys keys)
-	  (org-element--cache-sync (current-buffer) (point-max))
-	  (let ((seen '()))
-	    (avl-tree-mapc
-	     (lambda (element)
-	       (let ((beg (org-element-property :begin element))
-		     (type (org-element-type element)))
-		 (let ((real (let (org-element-use-cache)
-			       (goto-char
-				(if (memq type '(item table-row)) (1+ beg)
-				  beg))
-			       (org-element-at-point))))
-		   (cond
-		    ((member real seen)
-		     (message
-		      "======\nWARNING. Two entries for the same element\n\n %s"
-		      element))
-		    ((not (equal real element))
-		     (message
-		      "======\nWARNING. Corrupted element (%s) at %d\n\nReal:\
-	%s\n\nCached: %s\n\nLast request: %s"
-		      (org-element-type element) beg real element (car requests)))
-		    (t (push real seen))))))
-	     org-element--cache)))))))
-
-(define-minor-mode element-debug-mode
-  "Minor mode to debug Org Element cache."
-  nil " OrgCacheD" nil
-  (if element-debug-mode
-      (progn (setq org-element-cache-sync-idle-time 3600)
-	     (add-hook 'after-change-functions 'element-check-cache t t))
-    (setq org-element-cache-sync-idle-time 0.6)
-    (remove-hook 'after-change-functions 'element-check-cache t)))
-
-(provide 'org-element-debug)