Add version 0.50HEADv0.50master

1 files changed, 151 insertions, 0 deletions

diff --git a/ol-file-paged.el b/ol-file-paged.el
new file mode 100644
index 0000000..ad473ec
--- /dev/null
+++ b/ol-file-paged.el
@@ -0,0 +1,151 @@
+;;; 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