diff options
Diffstat (limited to '.emacs.d/lisp/my/my-pdf-tools.el')
| -rw-r--r-- | .emacs.d/lisp/my/my-pdf-tools.el | 200 |
1 files changed, 0 insertions, 200 deletions
diff --git a/.emacs.d/lisp/my/my-pdf-tools.el b/.emacs.d/lisp/my/my-pdf-tools.el deleted file mode 100644 index 8fe884c..0000000 --- a/.emacs.d/lisp/my/my-pdf-tools.el +++ /dev/null @@ -1,200 +0,0 @@ -;;; 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 |