Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

598 lines
19 KiB

4 years ago
  1. ;;; pdf-outline.el --- Outline for PDF buffer -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2013, 2014 Andreas Politz
  3. ;; Author: Andreas Politz <politza@fh-trier.de>
  4. ;; Keywords: files, multimedia
  5. ;; This program is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. ;;; Commentary:
  16. ;;
  17. (require 'outline)
  18. (require 'pdf-links)
  19. (require 'pdf-view)
  20. (require 'pdf-util)
  21. (require 'cl-lib)
  22. (require 'imenu)
  23. (require 'let-alist)
  24. ;;; Code:
  25. ;;
  26. ;; User options
  27. ;;
  28. (defgroup pdf-outline nil
  29. "Display a navigatable outline of a PDF document."
  30. :group 'pdf-tools)
  31. (defcustom pdf-outline-buffer-indent 2
  32. "The level of indent in the Outline buffer."
  33. :type 'integer
  34. :group 'pdf-outline)
  35. (defcustom pdf-outline-enable-imenu t
  36. "Whether `imenu' should be enabled in PDF documents."
  37. :group 'pdf-outline
  38. :type '(choice (const :tag "Yes" t)
  39. (const :tag "No" nil)))
  40. (defcustom pdf-outline-imenu-keep-order t
  41. "Whether `imenu' should be advised not to reorder the outline."
  42. :group 'pdf-outline
  43. :type '(choice (const :tag "Yes" t)
  44. (const :tag "No" nil)))
  45. (defcustom pdf-outline-imenu-use-flat-menus nil
  46. "Whether the constructed Imenu should be a list, rather than a tree."
  47. :group 'pdf-outline
  48. :type '(choice (const :tag "Yes" t)
  49. (const :tag "No" nil)))
  50. (defcustom pdf-outline-display-buffer-action '(nil . nil)
  51. "The display action used, when displaying the outline buffer."
  52. :group 'pdf-outline
  53. :type display-buffer--action-custom-type)
  54. (defcustom pdf-outline-display-labels nil
  55. "Whether the outline should display labels instead of page numbers.
  56. Usually a page's label is it's displayed page number."
  57. :group 'pdf-outline
  58. :type 'boolean)
  59. (defvar pdf-outline-minor-mode-map
  60. (let ((km (make-sparse-keymap)))
  61. (define-key km (kbd "o") 'pdf-outline)
  62. km)
  63. "Keymap used for `pdf-outline-minor-mode'.")
  64. (defvar pdf-outline-buffer-mode-map
  65. (let ((kmap (make-sparse-keymap)))
  66. (dotimes (i 10)
  67. (define-key kmap (vector (+ i ?0)) 'digit-argument))
  68. (define-key kmap "-" 'negative-argument)
  69. (define-key kmap (kbd "p") 'previous-line)
  70. (define-key kmap (kbd "n") 'next-line)
  71. (define-key kmap (kbd "b") 'outline-backward-same-level)
  72. (define-key kmap (kbd "d") 'hide-subtree)
  73. (define-key kmap (kbd "a") 'show-all)
  74. (define-key kmap (kbd "s") 'show-subtree)
  75. (define-key kmap (kbd "f") 'outline-forward-same-level)
  76. (define-key kmap (kbd "u") 'pdf-outline-up-heading)
  77. (define-key kmap (kbd "Q") 'hide-sublevels)
  78. (define-key kmap (kbd "<") 'beginning-of-buffer)
  79. (define-key kmap (kbd ">") 'pdf-outline-end-of-buffer)
  80. (define-key kmap (kbd "TAB") 'outline-toggle-children)
  81. (define-key kmap (kbd "RET") 'pdf-outline-follow-link)
  82. (define-key kmap (kbd "C-o") 'pdf-outline-display-link)
  83. (define-key kmap (kbd "SPC") 'pdf-outline-display-link)
  84. (define-key kmap [mouse-1] 'pdf-outline-mouse-display-link)
  85. (define-key kmap (kbd "o") 'pdf-outline-select-pdf-window)
  86. (define-key kmap (kbd ".") 'pdf-outline-move-to-current-page)
  87. ;; (define-key kmap (kbd "Q") 'pdf-outline-quit)
  88. (define-key kmap (kbd "C-c C-q") 'pdf-outline-quit-and-kill)
  89. (define-key kmap (kbd "q") 'quit-window)
  90. (define-key kmap (kbd "M-RET") 'pdf-outline-follow-link-and-quit)
  91. (define-key kmap (kbd "C-c C-f") 'pdf-outline-follow-mode)
  92. kmap)
  93. "Keymap used in `pdf-outline-buffer-mode'.")
  94. ;;
  95. ;; Internal Variables
  96. ;;
  97. (define-button-type 'pdf-outline
  98. 'face nil
  99. 'keymap nil)
  100. (defvar-local pdf-outline-pdf-window nil
  101. "The PDF window corresponding to this outline buffer.")
  102. (defvar-local pdf-outline-pdf-document nil
  103. "The PDF filename or buffer corresponding to this outline
  104. buffer.")
  105. (defvar-local pdf-outline-follow-mode-last-link nil)
  106. ;;
  107. ;; Functions
  108. ;;
  109. ;;;###autoload
  110. (define-minor-mode pdf-outline-minor-mode
  111. "Display an outline of a PDF document.
  112. This provides a PDF's outline on the menu bar via imenu.
  113. Additionally the same outline may be viewed in a designated
  114. buffer.
  115. \\{pdf-outline-minor-mode-map}"
  116. nil nil nil
  117. (pdf-util-assert-pdf-buffer)
  118. (cond
  119. (pdf-outline-minor-mode
  120. (when pdf-outline-enable-imenu
  121. (pdf-outline-imenu-enable)))
  122. (t
  123. (when pdf-outline-enable-imenu
  124. (pdf-outline-imenu-disable)))))
  125. (define-derived-mode pdf-outline-buffer-mode outline-mode "PDF Outline"
  126. "View and traverse the outline of a PDF file.
  127. Press \\[pdf-outline-display-link] to display the PDF document,
  128. \\[pdf-outline-select-pdf-window] to select it's window,
  129. \\[pdf-outline-move-to-current-page] to move to the outline item
  130. of the current page, \\[pdf-outline-follow-link] to goto the
  131. corresponding page or \\[pdf-outline-follow-link-and-quit] to
  132. additionally quit the Outline.
  133. \\[pdf-outline-follow-mode] enters a variant of
  134. `next-error-follow-mode'. Most `outline-mode' commands are
  135. rebound to their respective last character.
  136. \\{pdf-outline-buffer-mode-map}"
  137. (setq-local outline-regexp "\\( *\\).")
  138. (setq-local outline-level
  139. (lambda nil (1+ (/ (length (match-string 1))
  140. pdf-outline-buffer-indent))))
  141. (toggle-truncate-lines 1)
  142. (setq buffer-read-only t)
  143. (when (> (count-lines 1 (point-max))
  144. (* 1.5 (frame-height)))
  145. (hide-sublevels 1))
  146. (message "%s"
  147. (substitute-command-keys
  148. (concat
  149. "Try \\[pdf-outline-display-link], "
  150. "\\[pdf-outline-select-pdf-window], "
  151. "\\[pdf-outline-move-to-current-page] or "
  152. "\\[pdf-outline-follow-link-and-quit]"))))
  153. (define-minor-mode pdf-outline-follow-mode
  154. "Display links as point moves."
  155. nil nil nil
  156. (setq pdf-outline-follow-mode-last-link nil)
  157. (cond
  158. (pdf-outline-follow-mode
  159. (add-hook 'post-command-hook 'pdf-outline-follow-mode-pch nil t))
  160. (t
  161. (remove-hook 'post-command-hook 'pdf-outline-follow-mode-pch t))))
  162. (defun pdf-outline-follow-mode-pch ()
  163. (let ((link (pdf-outline-link-at-pos (point))))
  164. (when (and link
  165. (not (eq link pdf-outline-follow-mode-last-link)))
  166. (setq pdf-outline-follow-mode-last-link link)
  167. (pdf-outline-display-link (point)))))
  168. ;;;###autoload
  169. (defun pdf-outline (&optional buffer no-select-window-p)
  170. "Display an PDF outline of BUFFER.
  171. BUFFER defaults to the current buffer. Select the outline
  172. buffer, unless NO-SELECT-WINDOW-P is non-nil."
  173. (interactive (list nil (or current-prefix-arg
  174. (consp last-nonmenu-event))))
  175. (let ((win
  176. (display-buffer
  177. (pdf-outline-noselect buffer)
  178. pdf-outline-display-buffer-action)))
  179. (unless no-select-window-p
  180. (select-window win))))
  181. (defun pdf-outline-noselect (&optional buffer)
  182. "Create an PDF outline of BUFFER, but don't display it."
  183. (save-current-buffer
  184. (and buffer (set-buffer buffer))
  185. (pdf-util-assert-pdf-buffer)
  186. (let* ((pdf-buffer (current-buffer))
  187. (pdf-file (pdf-view-buffer-file-name))
  188. (pdf-window (and (eq pdf-buffer (window-buffer))
  189. (selected-window)))
  190. (bname (pdf-outline-buffer-name))
  191. (buffer-exists-p (get-buffer bname))
  192. (buffer (get-buffer-create bname)))
  193. (with-current-buffer buffer
  194. (unless buffer-exists-p
  195. (when (= 0 (save-excursion
  196. (pdf-outline-insert-outline pdf-buffer)))
  197. (kill-buffer buffer)
  198. (error "PDF has no outline"))
  199. (pdf-outline-buffer-mode))
  200. (set (make-local-variable 'other-window-scroll-buffer)
  201. pdf-buffer)
  202. (setq pdf-outline-pdf-window pdf-window
  203. pdf-outline-pdf-document (or pdf-file pdf-buffer))
  204. (current-buffer)))))
  205. (defun pdf-outline-buffer-name (&optional pdf-buffer)
  206. (unless pdf-buffer (setq pdf-buffer (current-buffer)))
  207. (let ((buf (format "*Outline %s*" (buffer-name pdf-buffer))))
  208. ;; (when (buffer-live-p (get-buffer buf))
  209. ;; (kill-buffer buf))
  210. buf))
  211. (defun pdf-outline-insert-outline (pdf-buffer)
  212. (let ((labels (and pdf-outline-display-labels
  213. (pdf-info-pagelabels pdf-buffer)))
  214. (nitems 0))
  215. (dolist (item (pdf-info-outline pdf-buffer))
  216. (let-alist item
  217. (when (eq .type 'goto-dest)
  218. (insert-text-button
  219. (concat
  220. (make-string (* (1- .depth) pdf-outline-buffer-indent) ?\s)
  221. .title
  222. (if (> .page 0)
  223. (format " (%s)"
  224. (if labels
  225. (nth (1- .page) labels)
  226. .page))
  227. "(invalid)"))
  228. 'type 'pdf-outline
  229. 'help-echo (pdf-links-action-to-string item)
  230. 'pdf-outline-link item)
  231. (newline)
  232. (cl-incf nitems))))
  233. nitems))
  234. (defun pdf-outline-get-pdf-window (&optional if-visible-p)
  235. (save-selected-window
  236. (let* ((buffer (cond
  237. ((buffer-live-p pdf-outline-pdf-document)
  238. pdf-outline-pdf-document)
  239. ((bufferp pdf-outline-pdf-document)
  240. (error "PDF buffer was killed"))
  241. (t
  242. (or
  243. (find-buffer-visiting
  244. pdf-outline-pdf-document)
  245. (find-file-noselect
  246. pdf-outline-pdf-document)))))
  247. (pdf-window
  248. (if (and (window-live-p pdf-outline-pdf-window)
  249. (eq buffer
  250. (window-buffer pdf-outline-pdf-window)))
  251. pdf-outline-pdf-window
  252. (or (get-buffer-window buffer)
  253. (and (null if-visible-p)
  254. (display-buffer
  255. buffer
  256. '(nil (inhibit-same-window . t))))))))
  257. (setq pdf-outline-pdf-window pdf-window))))
  258. ;;
  259. ;; Commands
  260. ;;
  261. (defun pdf-outline-move-to-current-page ()
  262. "Move to the item corresponding to the current page.
  263. Open nodes as necessary."
  264. (interactive)
  265. (let (page)
  266. (with-selected-window (pdf-outline-get-pdf-window)
  267. (setq page (pdf-view-current-page)))
  268. (pdf-outline-move-to-page page)))
  269. (defun pdf-outline-quit-and-kill ()
  270. "Quit browsing the outline and kill it's buffer."
  271. (interactive)
  272. (pdf-outline-quit t))
  273. (defun pdf-outline-quit (&optional kill)
  274. "Quit browsing the outline buffer."
  275. (interactive "P")
  276. (let ((win (selected-window)))
  277. (pdf-outline-select-pdf-window t)
  278. (quit-window kill win)))
  279. (defun pdf-outline-up-heading (arg &optional invisible-ok)
  280. "Like `outline-up-heading', but `push-mark' first."
  281. (interactive "p")
  282. (let ((pos (point)))
  283. (outline-up-heading arg invisible-ok)
  284. (unless (= pos (point))
  285. (push-mark pos))))
  286. (defun pdf-outline-end-of-buffer ()
  287. "Move to the end of the outline buffer."
  288. (interactive)
  289. (let ((pos (point)))
  290. (goto-char (point-max))
  291. (when (and (eobp)
  292. (not (bobp))
  293. (null (button-at (point))))
  294. (forward-line -1))
  295. (unless (= pos (point))
  296. (push-mark pos))))
  297. (defun pdf-outline-link-at-pos (&optional pos)
  298. (unless pos (setq pos (point)))
  299. (let ((button (or (button-at pos)
  300. (button-at (1- pos)))))
  301. (and button
  302. (button-get button
  303. 'pdf-outline-link))))
  304. (defun pdf-outline-follow-link (&optional pos)
  305. "Select PDF window and move to the page corresponding to POS."
  306. (interactive)
  307. (unless pos (setq pos (point)))
  308. (let ((link (pdf-outline-link-at-pos pos)))
  309. (unless link
  310. (error "Nothing to follow here"))
  311. (select-window (pdf-outline-get-pdf-window))
  312. (pdf-links-action-perform link)))
  313. (defun pdf-outline-follow-link-and-quit (&optional pos)
  314. "Select PDF window and move to the page corresponding to POS.
  315. Then quit the outline window."
  316. (interactive)
  317. (let ((link (pdf-outline-link-at-pos (or pos (point)))))
  318. (pdf-outline-quit)
  319. (unless link
  320. (error "Nothing to follow here"))
  321. (pdf-links-action-perform link)))
  322. (defun pdf-outline-display-link (&optional pos)
  323. "Display the page corresponding to the link at POS."
  324. (interactive)
  325. (unless pos (setq pos (point)))
  326. (let ((inhibit-redisplay t)
  327. (link (pdf-outline-link-at-pos pos)))
  328. (unless link
  329. (error "Nothing to follow here"))
  330. (with-selected-window (pdf-outline-get-pdf-window)
  331. (pdf-links-action-perform link))
  332. (force-mode-line-update t)))
  333. (defun pdf-outline-mouse-display-link (event)
  334. "Display the page corresponding to the position of EVENT."
  335. (interactive "@e")
  336. (pdf-outline-display-link
  337. (posn-point (event-start event))))
  338. (defun pdf-outline-select-pdf-window (&optional no-create-p)
  339. "Display and select the PDF document window."
  340. (interactive)
  341. (let ((win (pdf-outline-get-pdf-window no-create-p)))
  342. (and (window-live-p win)
  343. (select-window win))))
  344. (defun pdf-outline-toggle-subtree ()
  345. "Toggle hidden state of the current complete subtree."
  346. (interactive)
  347. (save-excursion
  348. (outline-back-to-heading)
  349. (if (not (outline-invisible-p (line-end-position)))
  350. (hide-subtree)
  351. (show-subtree))))
  352. (defun pdf-outline-move-to-page (page)
  353. "Move to an outline item corresponding to PAGE."
  354. (interactive
  355. (list (or (and current-prefix-arg
  356. (prefix-numeric-value current-prefix-arg))
  357. (read-number "Page: "))))
  358. (goto-char (pdf-outline-position-of-page page))
  359. (save-excursion
  360. (while (outline-invisible-p)
  361. (outline-up-heading 1 t)
  362. (show-children)))
  363. (save-excursion
  364. (when (outline-invisible-p)
  365. (outline-up-heading 1 t)
  366. (show-children)))
  367. (back-to-indentation))
  368. (defun pdf-outline-position-of-page (page)
  369. (let (curpage)
  370. (save-excursion
  371. (goto-char (point-min))
  372. (while (and (setq curpage (alist-get 'page (pdf-outline-link-at-pos)))
  373. (< curpage page))
  374. (forward-line))
  375. (point))))
  376. ;;
  377. ;; Imenu Support
  378. ;;
  379. ;;;###autoload
  380. (defun pdf-outline-imenu-enable ()
  381. "Enable imenu in the current PDF buffer."
  382. (interactive)
  383. (pdf-util-assert-pdf-buffer)
  384. (setq-local imenu-create-index-function
  385. (if pdf-outline-imenu-use-flat-menus
  386. 'pdf-outline-imenu-create-index-flat
  387. 'pdf-outline-imenu-create-index-tree))
  388. (imenu-add-to-menubar "PDF Outline"))
  389. (defun pdf-outline-imenu-disable ()
  390. "Disable imenu in the current PDF buffer."
  391. (interactive)
  392. (pdf-util-assert-pdf-buffer)
  393. (setq-local imenu-create-index-function nil)
  394. (local-set-key [menu-bar index] nil)
  395. (when (eq pdf-view-mode-map
  396. (keymap-parent (current-local-map)))
  397. (use-local-map (keymap-parent (current-local-map)))))
  398. (defun pdf-outline-imenu-create-item (link &optional labels)
  399. (let-alist link
  400. (list (format "%s (%s)" .title (if labels
  401. (nth (1- .page) labels)
  402. .page))
  403. 0
  404. 'pdf-outline-imenu-activate-link
  405. link)))
  406. (defun pdf-outline-imenu-create-index-flat ()
  407. (let ((labels (and pdf-outline-display-labels
  408. (pdf-info-pagelabels)))
  409. index)
  410. (dolist (item (pdf-info-outline))
  411. (let-alist item
  412. (when (eq .type 'goto-dest)
  413. (push (pdf-outline-imenu-create-item item labels)
  414. index))))
  415. (nreverse index)))
  416. (defun pdf-outline-imenu-create-index-tree ()
  417. (pdf-outline-imenu-create-index-tree-1
  418. (pdf-outline-treeify-outline-list
  419. (cl-remove-if-not
  420. (lambda (type)
  421. (eq type 'goto-dest))
  422. (pdf-info-outline)
  423. :key (apply-partially 'alist-get 'type)))
  424. (and pdf-outline-display-labels
  425. (pdf-info-pagelabels))))
  426. (defun pdf-outline-imenu-create-index-tree-1 (nodes &optional labels)
  427. (mapcar (lambda (node)
  428. (let (children)
  429. (when (consp (caar node))
  430. (setq children (cdr node)
  431. node (car node)))
  432. (let ((item
  433. (pdf-outline-imenu-create-item node labels)))
  434. (if children
  435. (cons (alist-get 'title node)
  436. (cons item (pdf-outline-imenu-create-index-tree-1
  437. children labels)))
  438. item))))
  439. nodes))
  440. (defun pdf-outline-treeify-outline-list (list)
  441. (when list
  442. (let ((depth (alist-get 'depth (car list)))
  443. result)
  444. (while (and list
  445. (>= (alist-get 'depth (car list))
  446. depth))
  447. (when (= (alist-get 'depth (car list)) depth)
  448. (let ((item (car list)))
  449. (when (and (cdr list)
  450. (> (alist-get 'depth (cadr list))
  451. depth))
  452. (setq item
  453. (cons
  454. item
  455. (pdf-outline-treeify-outline-list (cdr list)))))
  456. (push item result)))
  457. (setq list (cdr list)))
  458. (reverse result))))
  459. (defun pdf-outline-imenu-activate-link (&rest args)
  460. ;; bug #14029
  461. (when (eq (nth 2 args) 'pdf-outline-imenu-activate-link)
  462. (setq args (cdr args)))
  463. (pdf-links-action-perform (nth 2 args)))
  464. (defadvice imenu--split-menu (around pdf-outline activate)
  465. "Advice to keep the original outline order.
  466. Calls `pdf-outline-imenu--split-menu' instead, if in a PDF
  467. buffer and `pdf-outline-imenu-keep-order' is non-nil."
  468. (if (not (and (pdf-util-pdf-buffer-p)
  469. pdf-outline-imenu-keep-order))
  470. ad-do-it
  471. (setq ad-return-value
  472. (pdf-outline-imenu--split-menu menulist title))))
  473. (defvar imenu--rescan-item)
  474. (defvar imenu-sort-function)
  475. (defvar imenu-create-index-function)
  476. (defvar imenu-max-items)
  477. (defun pdf-outline-imenu--split-menu (menulist title)
  478. "Replacement function for `imenu--split-menu'.
  479. This function does not move sub-menus to the top, therefore
  480. keeping the original outline order of the document. Also it does
  481. not call `imenu-sort-function'."
  482. (let ((menulist (copy-sequence menulist))
  483. keep-at-top)
  484. (if (memq imenu--rescan-item menulist)
  485. (setq keep-at-top (list imenu--rescan-item)
  486. menulist (delq imenu--rescan-item menulist)))
  487. (if (> (length menulist) imenu-max-items)
  488. (setq menulist
  489. (mapcar
  490. (lambda (menu)
  491. (cons (format "From: %s" (caar menu)) menu))
  492. (imenu--split menulist imenu-max-items))))
  493. (cons title
  494. (nconc (nreverse keep-at-top) menulist))))
  495. ;; bugfix for imenu in Emacs 24.3 and below.
  496. (when (condition-case nil
  497. (progn (imenu--truncate-items '(("" 0))) nil)
  498. (error t))
  499. (eval-after-load "imenu"
  500. '(defun imenu--truncate-items (menulist)
  501. "Truncate all strings in MENULIST to `imenu-max-item-length'."
  502. (mapc (lambda (item)
  503. ;; Truncate if necessary.
  504. (when (and (numberp imenu-max-item-length)
  505. (> (length (car item)) imenu-max-item-length))
  506. (setcar item (substring (car item) 0 imenu-max-item-length)))
  507. (when (imenu--subalist-p item)
  508. (imenu--truncate-items (cdr item))))
  509. menulist))))
  510. (provide 'pdf-outline)
  511. ;;; pdf-outline.el ends here
  512. ;; Local Variables:
  513. ;; byte-compile-warnings: (not obsolete)
  514. ;; End: