From 093ffa5fbf7143f4668bb0a3dc9659a5cc836e12 Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Sat, 17 Jun 2023 17:20:29 +1000 Subject: Moving things one level deeper To ease gnu stow usage. Now we can do stow -t ~ emacs --- emacs/.emacs.d/lisp/my/my-pdf-tools.el | 200 +++++++++++++++++++++++++++++++++ 1 file changed, 200 insertions(+) create mode 100644 emacs/.emacs.d/lisp/my/my-pdf-tools.el (limited to 'emacs/.emacs.d/lisp/my/my-pdf-tools.el') 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 +;; 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 . + +;;; 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 -- cgit v1.2.3