org-noter-pdftools-create-skeleton "Contents"
oapneat opened this issue · comments
I'm getting to grips with org-noter, being able to pull my highlights to an org file is the final piece of the puzzle in my work flow!
However, org-noter-pdftools-create-skeleton creates a rather busy output for my taste. Noteably there is a '** Contents' subheading above the '** Comment' subheading that seems to just contain a random portion of the whole highlight which appears below in the '** Comment' subheading.
Is there a way to simplify the output of org-noter-pdftools-create-skeleton? Or prevent it from producing the '** Contents' subheading??
This is Emacs where you hack stuffs to get it to your likings.
Looking at the code of org-noter-pdftools-create-skeleton
, you can easily define your custom version of the function with the part that inserts "Contents" heading removed, which is
(when (car contents)
(when org-noter-pdftools-insert-content-heading
(org-noter--insert-heading (1+ level) "Contents"))
(insert (car contents)))
So here is the custom version with that part removed,
(defun my-org-noter-pdftools-create-skeleton ()
"Create notes skeleton with the PDF outline or annotations.
Only available with PDF Tools."
(interactive)
(org-noter--with-valid-session
(cond
((eq (org-noter--session-doc-mode session) 'pdf-view-mode)
(let* ((ast (org-noter--parse-root))
(top-level (or (org-element-property :level ast) 0))
(options '(("Outline" . (outline))
("Annotations" . (annots))
("Both" . (outline annots))))
answer output-data)
(with-current-buffer (org-noter--session-doc-buffer session)
(setq answer (assoc (completing-read "What do you want to import? " options nil t) options))
(when (memq 'outline answer)
(dolist (item (pdf-info-outline))
(let ((type (alist-get 'type item))
(page (alist-get 'page item))
(depth (alist-get 'depth item))
(title (alist-get 'title item))
(top (alist-get 'top item))
pdftools-link path)
(when (and (eq type 'goto-dest)
(> page 0))
(when org-noter-pdftools-use-pdftools-link-location
(setq path
(funcall org-noter-pdftools-path-generator (buffer-file-name)))
(if title
(setq pdftools-link
(concat
org-pdftools-link-prefix ":"
path
"::"
(number-to-string page)
"++"
(number-to-string top)
org-pdftools-search-string-separator
(replace-regexp-in-string
" "
"%20"
title)))
(setq pdftools-link
(concat
org-pdftools-link-prefix ":"
path
"::"
(number-to-string page)
"++"
(number-to-string top)))))
(push
(vector
title
(if org-noter-pdftools-use-pdftools-link-location pdftools-link
(cons page top))
(1+ depth)
nil)
output-data)))))
(when (memq 'annots answer)
(let ((possible-annots (list '("Highlights" . highlight)
'("Underlines" . underline)
'("Squigglies" . squiggly)
'("Text notes" . text)
'("Strikeouts" . strike-out)
'("Links" . link)
'("ALL" . all)))
chosen-annots insert-contents pages-with-links)
(while (> (length possible-annots) 1)
(let* ((chosen-string (completing-read "Which types of annotations do you want? "
possible-annots nil t))
(chosen-pair (assoc chosen-string possible-annots)))
(cond ((eq (cdr chosen-pair) 'all)
(dolist (annot possible-annots)
(when (and (cdr annot) (not (eq (cdr annot) 'all)))
(push (cdr annot) chosen-annots)))
(setq possible-annots nil))
((cdr chosen-pair)
(push (cdr chosen-pair) chosen-annots)
(setq possible-annots (delq chosen-pair possible-annots))
(when (= 1 (length chosen-annots)) (push '("DONE") possible-annots)))
(t
(setq possible-annots nil)))))
(setq insert-contents (y-or-n-p "Should we insert the annotations contents? "))
(dolist (item (pdf-info-getannots))
(let* ((type (alist-get 'type item))
(page (alist-get 'page item))
(edges (or (org-noter--pdf-tools-edges-to-region (alist-get 'markup-edges item))
(alist-get 'edges item)))
(top (nth 1 edges))
(item-subject (alist-get 'subject item))
(item-contents (alist-get 'contents item))
(id (symbol-name (alist-get 'id item)))
name contents pdftools-link path)
(when org-noter-pdftools-use-pdftools-link-location
(setq path (funcall org-noter-pdftools-path-generator (buffer-file-name)))
(setq pdftools-link (concat org-pdftools-link-prefix ":" path "::"
(number-to-string page) "++"
(number-to-string top) ";;"
id)))
(when (and (memq type chosen-annots) (> page 0))
(if (eq type 'link)
(cl-pushnew page pages-with-links)
(setq name (cond ((eq type 'highlight) "Highlight")
((eq type 'underline) "Underline")
((eq type 'squiggly) "Squiggly")
((eq type 'text) "Text note")
((eq type 'strike-out) "Strikeout")))
(when insert-contents
(setq contents (cons (pdf-info-gettext page edges)
(and (or (and item-subject (> (length item-subject) 0))
(and item-contents (> (length item-contents) 0)))
(concat (or item-subject "")
(if (and item-subject item-contents) "\n" "")
(or item-contents ""))))))
(push (vector (format "%s on page %d" name page) (if org-noter-pdftools-use-pdftools-link-location
pdftools-link
(cons page top)) 'inside contents)
output-data)))))
(dolist (page pages-with-links)
(let ((links (pdf-info-pagelinks page))
type)
(dolist (link links)
(setq type (alist-get 'type link))
(unless (eq type 'goto-dest) ;; NOTE(nox): Ignore internal links
(let* ((edges (alist-get 'edges link))
(title (alist-get 'title link))
(top (nth 1 edges))
(target-page (alist-get 'page link))
target heading-text pdftools-link path)
(when org-noter-pdftools-use-pdftools-link-location
(setq path
(funcall org-noter-pdftools-path-generator (buffer-file-name)))
(setq pdftools-link (concat org-pdftools-link-prefix ":" path "::"
(number-to-string page) "++"
(number-to-string top))))
(unless (and title (> (length title) 0)) (setq title (pdf-info-gettext page edges)))
(cond
((eq type 'uri)
(setq target (alist-get 'uri link)
heading-text (format "Link on page %d: [[%s][%s]]" page target title)))
((eq type 'goto-remote)
(setq target (concat "file:" (alist-get 'filename link))
heading-text (format "Link to document on page %d: [[%s][%s]]" page target title))
(when target-page
(setq heading-text (concat heading-text (format " (target page: %d)" target-page)))))
(t (error "Unexpected link type")))
(push
(vector
heading-text
(if org-noter-pdftools-use-pdftools-link-location
pdftools-link
(cons page top))
'inside
nil)
output-data))))))))
(when output-data
(if (memq 'annots answer)
(setq output-data
(sort output-data
(lambda (e1 e2)
(or (not (aref e1 1))
(and (aref e2 1)
(org-noter--compare-locations '< (aref e1 1) (aref e2 1)))))))
(setq output-data (nreverse output-data)))
(push (vector "Skeleton" nil 1 nil) output-data)))
(with-current-buffer (org-noter--session-notes-buffer session)
;; NOTE(nox): org-with-wide-buffer can't be used because we want to reset the
;; narrow region to include the new headings
(widen)
(save-excursion
(goto-char (org-element-property :end ast))
(let (last-absolute-level
title location relative-level contents
level)
(dolist (data output-data)
(setq title (aref data 0)
location (aref data 1)
relative-level (aref data 2)
contents (aref data 3))
(if (symbolp relative-level)
(setq level (1+ last-absolute-level))
(setq last-absolute-level (+ top-level relative-level)
level last-absolute-level))
(org-noter--insert-heading level title nil location)
(when (cdr contents)
(org-noter--insert-heading (1+ level) "Comment")
(insert (cdr contents)))))
(setq ast (org-noter--parse-root))
(org-noter--narrow-to-root ast)
(goto-char (org-element-property :begin ast))
(outline-hide-subtree)
(org-show-children 2)))))
(t (error "This command is only supported on PDF Tools")))))
Put the above in your .emacs file and call my-org-noter-pdftools-create-skeleton
from now on.