Moving things one level deeper

To ease gnu stow usage. Now we can do

stow -t ~ emacs

1 files changed, 200 insertions, 0 deletions

diff --git a/emacs/.emacs.d/lisp/my/my-pdf-tools.el b/emacs/.emacs.d/lisp/my/my-pdf-tools.el
new file mode 100644
index 0000000..8fe884c
--- /dev/null
+++ b/emacs/.emacs.d/lisp/my/my-pdf-tools.el
@@ -0,0 +1,200 @@
+;;; my-pdf-tools.el -- Extensions for pdf-tools -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation.
+
+;; Author: Yuchen Pei <id@ypei.org>
+;; Package-Requires: ((emacs "28.2"))
+
+;; This file is part of dotfiles.
+
+;; dotfiles is free software: you can redistribute it and/or modify it under
+;; the terms of the GNU Affero General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; dotfiles is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General
+;; Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public
+;; License along with dotfiles.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Extensions for pdf-tools.
+
+;;; Code:
+
+(require 'pdf-tools)
+(defvar my-pdf-view-current-node nil)
+(defvar my-pdf-view-navigation-functions
+  '(my-pdf-view-forward-node
+    my-pdf-view-backward-node
+    my-pdf-view-forward-node-same-depth
+    my-pdf-view-backward-node-same-depth
+    my-pdf-view-backward-node-lower-depth))
+
+(defun my-pdf-outline-update-with-path (outline)
+  (let ((path) (depth 0))
+    (dolist (node outline)
+      (let* ((node-depth (alist-get 'depth node))
+	           (node-title (alist-get 'title node))
+	           (depth-diff (- node-depth depth 1)))
+	      (cond ((< depth-diff 0) (dotimes (unused (- depth-diff))
+				                          (pop path)))
+	            ((> depth-diff 0) (dotimes (unused depth-diff)
+				                          (push "" path))))
+	      (push node-title path)
+	      (setq depth node-depth))
+      (setf (alist-get 'title node) (string-join (reverse path) "/")))
+    outline))
+
+(defun my-pdf-jump-and-set-current-node (node)
+  (pdf-links-action-perform node)
+  (setq my-pdf-view-current-node node))
+
+(defun my-pdf-outline-jump ()
+  (interactive)
+  (let ((outline (my-pdf-outline-update-with-path
+		              (pdf-info-outline (current-buffer)))))
+    (if (not outline) (message "PDF has no outline")
+      (let ((title (completing-read
+		                "Jump to: "
+		                (mapcar (lambda (node) (alist-get 'title node))
+			                      outline))))
+	      (pdf-links-action-perform
+	       (cl-find-if (lambda (node) (equal (alist-get 'title node) title))
+		                 outline))))))
+
+(defun my-pdf-view-next-node-by-page (outline)
+  (cl-find-if (lambda
+	              (node)
+	              (> (alist-get 'page node) (pdf-view-current-page))) outline))
+
+(defun my-pdf-view-next-node-by-node (current-node outline &optional depth-req)
+  (let ((next-node
+	       (catch 'ret
+	         (while outline
+	           (when (equal (car outline) current-node)
+	             (throw 'ret (cadr outline)))
+	           (setq outline (cdr outline))))))
+    (cond ((not depth-req) next-node)
+	        ((eq depth-req 'same-depth)
+	         (cl-find-if (lambda (node) (= (alist-get 'depth node)
+				                                 (alist-get 'depth current-node)))
+		                   (cdr outline)))
+	        (t (error "Unknown depth-req")))))
+
+(defun my-pdf-view-forward-node ()
+  (interactive)
+  (let ((outline (pdf-info-outline (current-buffer))))
+    (if (not outline) (message "PDF has no outline")
+      (my-pdf-jump-and-set-current-node
+       (if (and my-pdf-view-current-node
+		            (memq last-command my-pdf-view-navigation-functions))
+	         (my-pdf-view-next-node-by-node my-pdf-view-current-node outline)
+	       (my-pdf-view-next-node-by-page outline))))))
+
+(defun my-pdf-view-lowest-node-current-page (outline)
+  "returns the last node of the lowest depth on the current page"
+  (let ((result) (current-page (pdf-view-current-page)))
+    (catch 'ret
+      (while outline
+	      (let ((node (car outline)))
+	        (cond ((= (alist-get 'page node) current-page)
+		             (when (or (not result)
+			                     (<= (alist-get 'depth node)
+			                         (alist-get 'depth result)))
+		               (setq result node)))
+		            ((> (alist-get 'page node) current-page)
+		             (throw 'ret result))))
+	      (setq outline (cdr outline))))))
+
+(defun my-pdf-view-highest-node-current-page (outline)
+  "returns the first node of the highest depth on the current page"
+  (let ((result) (current-page (pdf-view-current-page)))
+    (catch 'ret
+      (while outline
+	      (let ((node (car outline)))
+	        (cond ((= (alist-get 'page node) current-page)
+		             (when (or (not result)
+			                     (> (alist-get 'depth node)
+			                        (alist-get 'depth result)))
+		               (setq result node)))
+		            ((> (alist-get 'page node) current-page)
+		             (throw 'ret result))))
+	      (setq outline (cdr outline))))))
+
+(defun my-pdf-view-forward-node-same-depth ()
+  (interactive)
+  (let ((outline (pdf-info-outline (current-buffer))))
+    (if (not outline) (message "PDF has no outline")
+      (my-pdf-jump-and-set-current-node
+       (my-pdf-view-next-node-by-node
+	      (if (and my-pdf-view-current-node
+		             (memq last-command my-pdf-view-navigation-functions))
+	          my-pdf-view-current-node
+	        (my-pdf-view-lowest-node-current-page outline))
+	      outline 'same-depth)))))
+
+(defun my-pdf-view-prev-node-by-node (current-node outline &optional depth-req)
+  (let ((prev-node) (depth (alist-get 'depth current-node)))
+    (catch 'ret
+      (dolist (node outline)
+	      (if (equal node current-node)
+	          (throw 'ret prev-node)
+	        (when (or (not depth-req)
+		                (and (eq depth-req 'same-depth)
+			                   (eq (alist-get 'depth node) depth))
+		                (and (eq depth-req 'lower-depth)
+			                   (< (alist-get 'depth node) depth)))
+	          (setq prev-node node)))))))
+
+(defun my-pdf-view-prev-node-by-page (outline)
+  (let ((prev-node))
+    (catch 'ret
+      (dolist (node outline)
+	      (if (>= (alist-get 'page node) (pdf-view-current-page))
+	          (throw 'ret prev-node)
+	        (setq prev-node node))))))
+
+(defun my-pdf-view-backward-node ()
+  (interactive)
+  (let ((outline (pdf-info-outline (current-buffer))))
+    (if (not outline) (message "PDF has no outline")
+      (my-pdf-jump-and-set-current-node
+       (if (and my-pdf-view-current-node
+		            (memq last-command my-pdf-view-navigation-functions))
+	         (my-pdf-view-prev-node-by-node my-pdf-view-current-node outline)
+	       (my-pdf-view-prev-node-by-page outline))))))
+
+(defun my-pdf-view-backward-node-same-depth ()
+  (interactive)
+  (let ((outline (pdf-info-outline (current-buffer))))
+    (if (not outline) (message "PDF has no outline")
+      (my-pdf-jump-and-set-current-node
+       (my-pdf-view-prev-node-by-node
+	      (if (and my-pdf-view-current-node
+		             (memq last-command my-pdf-view-navigation-functions))
+	          my-pdf-view-current-node
+	        (my-pdf-view-lowest-node-current-page outline))
+	      outline 'same-depth)))))
+
+(defun my-pdf-view-backward-node-lower-depth ()
+  (interactive)
+  (let ((outline (pdf-info-outline (current-buffer))))
+    (if (not outline) (message "PDF has no outline")
+      (my-pdf-jump-and-set-current-node
+       (my-pdf-view-prev-node-by-node
+	      (if (and my-pdf-view-current-node
+		             (memq last-command my-pdf-view-navigation-functions))
+	          my-pdf-view-current-node
+	        (my-pdf-view-lowest-node-current-page outline))
+	      outline 'lower-depth)))))
+
+(defun my-pdf-view-enlarge-a-bit () (interactive) (pdf-view-enlarge 1.01))
+(defun my-pdf-view-shrink-a-bit () (interactive) (pdf-view-enlarge .99))
+
+(provide 'my-pdf-tools)
+;;; my-pdf-tools.el ends here