;;; ol-file-paged.el --- Org file links with associated page number  -*- lexical-binding: t; -*-

;; Copyright (C) 2025  Simon Parri

;; Author: Simon Parri <simonparri@ganzeria.com>
;; Keywords: multimedia, hypermedia, docs
;; Package-Requires: ((emacs "24.4") (compat "28.1") (seq "1") (org "9.3"))
;; Version: 0.50

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program 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 General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This package provides a link type, "file-paged", that includes both the
;; name of the file and the page number.

;; Example: [[file-paged:doc.pdf::10]] is a link to doc.pdf at page 10.

;; ol-file-paged currently supports DocView and `pdf-tools'.  To support more
;; paged-media viewers, see `ol-file-paged-get-page-alist',
;; `ol-file-paged-get-title-alist' and `ol-file-paged-goto-page-alist'.

;;; Code:

(require 'ol)

(defun ol-file-paged--substrings (regexp string &optional start)
  "Return the list of all grouops of REGEXP in STRING.

Optional argument START causes search to start at that index in STRING."
  (declare (side-effect-free t))
  (save-match-data
    (when (string-match regexp string start)
      (mapcar
       (lambda (x)
         (if (and (car x) (cadr x))
             (substring string (car x) (cadr x))
           ""))
       (seq-partition
        (match-data) 2)))))

(defun ol-file-paged--assoc (alist &optional buffer)
  "Find the `cdr' of the element in ALIST whose key is BUFFER's major mode.

If BUFFER is nil, use the current buffer."
  (with-current-buffer (or buffer (current-buffer))
    (letrec
        ((f (lambda (mode)
              (if-let ((fn (assoc mode alist)))
                  (cdr fn)
                (when-let ((parent (get mode 'derived-mode-parent)))
                  (funcall f parent))))))
      (funcall f major-mode))))

(defvar ol-file-paged-get-page-alist
  ;; FIXME: When doc-view and pdf-tools don't use these macros
  ;; then change this code
  '((doc-view-mode . (lambda () (doc-view-current-page)))
    (pdf-view-mode . (lambda () (pdf-view-current-page))))
  "Alist of (MAJOR-MODE . FUNCTION) pairs.

Used by `ol-file-paged-get-page' to find the current page in a buffer in
MAJOR-MODE.  FUNCTION is called with no arguments in the buffer in
question.")

(defun ol-file-paged-get-page (&optional buffer)
  "Get the current page of BUFFER.

If BUFFER is nil, use the current buffer."
  (with-current-buffer (or buffer (current-buffer))
    (when-let ((f (ol-file-paged--assoc ol-file-paged-get-page-alist)))
      (funcall f))))

(defvar ol-file-paged-get-title-alist
  '()
  "Alist of (MAJOR-MODE . FUNCTION) pairs.

Used by `ol-file-paged-get-title' to find the title of a buffer in
MAJOR-MODE.  FUNCTION is called with no arguments in the buffer in
question.")

(defun ol-file-paged-get-title (&optional buffer)
  "Get the title of BUFFER.

If BUFFER is nil, use the current buffer."
  (with-current-buffer (or buffer (current-buffer))
    (when-let ((f (ol-file-paged--assoc
                   ol-file-paged-get-title-alist)))
      (funcall f))))

;;;###autoload
(defun ol-file-paged-store ()
  "Store a link to the current file+page.

Does nothing if `ol-file-paged-get-page' cannot determine the current
page."
  (when (apply #'derived-mode-p
               (mapcar #'car ol-file-paged-get-page-alist))
    (let ((page (ol-file-paged-get-page)))
      (org-link-store-props
       :type "file-paged"
       :link (format "file-paged:%s::%d" buffer-file-name page)
       :title (ol-file-paged-get-title)))))

(defvar ol-file-paged-goto-page-alist
  '((doc-view-mode . doc-view-goto-page)
    (pdf-view-mode . pdf-view-goto-page))
  "Alist of (MAJOR-MODE . FUNCTION) pairs.

Used by `ol-file-paged-open' to jump to a given page in a buffer in
MAJOR-MODE.  FUNCTION is called with the page number in the buffer in
question.")

;;;###autoload
(defun ol-file-paged-open (link &optional arg)
  "Open LINK when LINK is an file-paged link.

ARG is ignored."
  (ignore arg)
  (let* ((x (cdr
             (ol-file-paged--substrings
              "\\`\\(.+\\)::\\(.+\\)\\'"
              link)))
         (file (car x))
         (page (cadr x)))
    (org-open-file file t)
    (with-current-buffer (find-buffer-visiting file)
      (when-let ((f (ol-file-paged--assoc
                     ol-file-paged-goto-page-alist)))
        (funcall f (string-to-number page))))))

;;;###autoload
(with-eval-after-load 'ol
  (org-link-set-parameters
   "file-paged"
   :store #'ol-file-paged-store
   :follow #'ol-file-paged-open))

(provide 'ol-file-paged)
;;; ol-file-paged.el ends here