;;; 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