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