123 lines
4.5 KiB
EmacsLisp
123 lines
4.5 KiB
EmacsLisp
;;; jao-doc-view.el -- extensions for doc-view -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (c) 2013, 2015, 2017, 2018, 2019, 2021, 2022 Jose Antonio Ortega Ruiz
|
|
|
|
;; This file 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 file 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 <http://www.gnu.org/licenses/>.
|
|
|
|
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
|
|
;; Start date: Fri Feb 15, 2013 01:21
|
|
|
|
(require 'doc-view)
|
|
(require 'jao-pdf)
|
|
|
|
;;; Utilities
|
|
|
|
(defmacro jao-doc-view--funcall (a b &rest args)
|
|
`(cond ((derived-mode-p 'pdf-view-mode) (,a ,@args))
|
|
((derived-mode-p 'doc-view-mode) (,b ,@args))))
|
|
|
|
(defun jao-doc-view-current-page ()
|
|
(jao-doc-view--funcall pdf-view-current-page doc-view-current-page))
|
|
|
|
(defun jao-doc-view-goto-page (page &optional height)
|
|
(when page
|
|
(jao-doc-view--funcall pdf-view-goto-page doc-view-goto-page page))
|
|
(when (and height (derived-mode-p 'pdf-view-mode))
|
|
(image-set-window-vscroll
|
|
(round (/ (* height (cdr (pdf-view-image-size))) (frame-char-height))))))
|
|
|
|
;;; imenu
|
|
(defun jao-doc-view-enable-imenu (file-name goto-page)
|
|
(let ((ifun (lambda () (doc-view-imenu-index file-name goto-page)))
|
|
(doc-view-imenu-enabled t))
|
|
(doc-view-imenu-setup)
|
|
(setq-local imenu-create-index-function ifun)))
|
|
|
|
;;; Page trailing
|
|
(defvar-local jao-doc-view--trail-back ())
|
|
(defvar-local jao-doc-view--trail-fwd ())
|
|
|
|
(defun jao-doc-view--trail-push (dest-page)
|
|
(when-let (page (jao-doc-view-current-page))
|
|
(unless (eq (car jao-doc-view--trail-back) page)
|
|
(push page jao-doc-view--trail-back))))
|
|
|
|
(defun jao-doc-view-back ()
|
|
(interactive nil doc-view-mode)
|
|
(if-let (p (pop jao-doc-view--trail-back))
|
|
(progn (push (jao-doc-view-current-page) jao-doc-view--trail-fwd)
|
|
(jao-doc-view-goto-page p))
|
|
(message "No more back marks.")))
|
|
|
|
(defun jao-doc-view-forward ()
|
|
(interactive nil doc-view-mode)
|
|
(if-let (p (pop jao-doc-view--trail-fwd))
|
|
(progn (push (jao-doc-view-current-page) jao-doc-view--trail-back)
|
|
(jao-doc-view-goto-page p))
|
|
(message "No more forward marks.")))
|
|
|
|
(advice-add 'doc-view-goto-page :before #'jao-doc-view--trail-push)
|
|
|
|
;;; Extract text
|
|
(defun jao-doc-view-page-text (&optional re-render no-select)
|
|
(interactive "P")
|
|
(let* ((pno (doc-view-current-page))
|
|
(in buffer-file-name)
|
|
(cdir (or (doc-view--current-cache-dir) "/tmp"))
|
|
(out (format "%s/p%s.txt" cdir pno)))
|
|
(when (and (file-exists-p out) re-render)
|
|
(delete-file out))
|
|
(unless (file-exists-p out)
|
|
(shell-command-to-string (format "mutool convert -o %s %s %s" out in pno)))
|
|
(if no-select
|
|
out
|
|
(find-file out)
|
|
(view-mode))))
|
|
|
|
(define-key doc-view-mode-map "t" #'jao-doc-view-page-text)
|
|
|
|
;;; Find URLs
|
|
(defun jao-doc-view--full-txt ()
|
|
(expand-file-name "doc.txt" (doc-view--current-cache-dir)))
|
|
|
|
(defun jao-doc-view--collect-urls (file)
|
|
(with-current-buffer (find-file-noselect file)
|
|
(goto-char (point-min))
|
|
(let ((urls nil))
|
|
(while (re-search-forward "https?://" nil t)
|
|
(push (thing-at-point-url-at-point) urls))
|
|
urls)))
|
|
|
|
(defun jao-doc-view--page-urls (&optional all)
|
|
(let ((txt (jao-doc-view--full-txt)))
|
|
(cond ((and all (not (file-exists-p txt)))
|
|
(message "Full text not extracted yet: doing so!")
|
|
(doc-view-doc->txt txt (lambda () (message "Text extracted")))
|
|
'wait)
|
|
(all (jao-doc-view--collect-urls txt))
|
|
(t (jao-doc-view--collect-urls (jao-doc-view-page-text nil t))))))
|
|
|
|
(defun jao-doc-view-visit-url (all)
|
|
"Visit URL displayed in this page."
|
|
(interactive "P")
|
|
(let ((urls (jao-doc-view--page-urls all)))
|
|
(cond ((eq 'wait urls) (message "Extracting text, please wait and retry."))
|
|
((zerop (length urls))
|
|
(message "No URLs in this %s" (if all "document" "page")))
|
|
(t (when-let (url (completing-read "URL: " urls nil nil
|
|
(when (null (cdr urls)) (car urls))))
|
|
(browse-url url))))))
|
|
|
|
;;; .
|
|
(provide 'jao-doc-view)
|