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