1;;; pdf-sync.el --- Use synctex to correlate LaTeX-Sources with PDF positions. -*- lexical-binding:t -*-
2;; Copyright (C) 2013, 2014  Andreas Politz
3
4;; Author: Andreas Politz <politza@fh-trier.de>
5;; Keywords: files, doc-view, pdf
6
7;; This program is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; This program is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21;;
22;; The backward search uses a heuristic, which is pretty simple, but
23;; effective: It extracts the text around the click-position in the
24;; PDF, normalizes it's whitespace, deletes certain notorious
25;; character and translates certain other character into their latex
26;; equivalents.  This transformed text is split into a series of
27;; token.  A similar operation is performed on the source code around
28;; the position synctex points at.  These two sequences of token are
29;; aligned with a standard sequence alignment algorithm, resulting in
30;; an alist of matched and unmatched tokens.  This is then used to
31;; find the corresponding word from the PDF file in the LaTeX buffer.
32
33
34(require 'pdf-view)
35(require 'pdf-info)
36(require 'pdf-util)
37(require 'let-alist)
38
39;;; Code:
40
41(defgroup pdf-sync nil
42  "Jump from TeX sources to PDF pages and back."
43  :group 'pdf-tools)
44
45(defcustom pdf-sync-forward-display-pdf-key "C-c C-g"
46  "Key to jump from a TeX buffer to it's PDF file.
47
48This key is added to `TeX-source-correlate-method', when
49command `pdf-sync-minor-mode' is activated and this map is defined."
50  :group 'pdf-sync
51  :type 'key-sequence)
52
53(make-obsolete-variable
54 'pdf-sync-forward-display-pdf-key
55 "Bound in Auctex's to C-c C-v, if TeX-source-correlate-mode is activate." "1.0")
56
57(defcustom pdf-sync-backward-hook nil
58  "Hook ran after going to a source location.
59
60The hook is run in the TeX buffer."
61  :group 'pdf-sync
62  :type 'hook
63  :options '(pdf-sync-backward-beginning-of-word))
64
65(defcustom pdf-sync-forward-hook nil
66  "Hook ran after displaying the PDF buffer.
67
68The hook is run in the PDF's buffer."
69  :group 'pdf-sync
70  :type 'hook)
71
72(defcustom pdf-sync-forward-display-action nil
73  "Display action used when displaying PDF buffers."
74  :group 'pdf-sync
75  :type 'display-buffer--action-custom-type)
76
77(defcustom pdf-sync-backward-display-action nil
78  "Display action used when displaying TeX buffers."
79  :group 'pdf-sync
80  :type 'display-buffer--action-custom-type)
81
82(defcustom pdf-sync-locate-synctex-file-functions nil
83  "A list of functions for locating the synctex database.
84
85Each function on this hook should accept a single argument: The
86absolute path of a PDF file.  It should return the absolute path
87of the corresponding synctex database or nil, if it was unable to
88locate it."
89  :group 'pdf-sync
90  :type 'hook)
91
92(defvar pdf-sync-minor-mode-map
93  (let ((kmap (make-sparse-keymap)))
94    (define-key kmap [double-mouse-1] 'pdf-sync-backward-search-mouse)
95    (define-key kmap [C-mouse-1] 'pdf-sync-backward-search-mouse)
96    kmap))
97
98(defcustom pdf-sync-backward-redirect-functions nil
99  "List of functions which may redirect a backward search.
100
101Functions on this hook should accept three arguments, namely
102SOURCE, LINE and COLUMN, where SOURCE is the absolute filename of
103the source file and LINE and COLUMN denote the position in the
104file.  COLUMN may be negative, meaning unspecified.
105
106These functions should either return nil, if no redirection is
107necessary.  Or a list of the same structure, with some or all (or
108none) values modified.
109
110AUCTeX installs a function here which changes the backward search
111location for synthetic `TeX-region' files back to the equivalent
112position in the original tex file."
113  :group 'pdf-sync
114  :type '(repeat function))
115
116
117;;;###autoload
118(define-minor-mode pdf-sync-minor-mode
119  "Correlate a PDF position with the TeX file.
120\\<pdf-sync-minor-mode-map>
121This works via SyncTeX, which means the TeX sources need to have
122been compiled with `--synctex=1'.  In AUCTeX this can be done by
123setting `TeX-source-correlate-method' to 'synctex \(before AUCTeX
124is loaded\) and enabling `TeX-source-correlate-mode'.
125
126Then \\[pdf-sync-backward-search-mouse] in the PDF buffer will open the
127corresponding TeX location.
128
129If AUCTeX is your preferred tex-mode, this library arranges to
130bind `pdf-sync-forward-display-pdf-key' \(the default is `C-c C-g'\)
131to `pdf-sync-forward-search' in `TeX-source-correlate-map'.  This
132function displays the PDF page corresponding to the current
133position in the TeX buffer.  This function only works together
134with AUCTeX."
135  :group 'pdf-sync
136  (pdf-util-assert-pdf-buffer))
137
138
139;; * ================================================================== *
140;; * Backward search (PDF -> TeX)
141;; * ================================================================== *
142
143(defcustom pdf-sync-backward-use-heuristic t
144  "Whether to apply a heuristic when backward searching.
145
146If nil, just go where Synctex tells us.  Otherwise try to find
147the exact location of the clicked-upon text in the PDF."
148  :group 'pdf-sync
149  :type 'boolean)
150
151(defcustom pdf-sync-backward-text-translations
152  '((88 "X" "sum")
153    (94 "textasciicircum")
154    (126 "textasciitilde")
155    (169 "copyright" "textcopyright")
156    (172 "neg" "textlnot")
157    (174 "textregistered" "textregistered")
158    (176 "textdegree")
159    (177 "pm" "textpm")
160    (181 "upmu" "mu")
161    (182 "mathparagraph" "textparagraph" "P" "textparagraph")
162    (215 "times")
163    (240 "eth" "dh")
164    (915 "Upgamma" "Gamma")
165    (920 "Uptheta" "Theta")
166    (923 "Uplambda" "Lambda")
167    (926 "Upxi" "Xi")
168    (928 "Uppi" "Pi")
169    (931 "Upsigma" "Sigma")
170    (933 "Upupsilon" "Upsilon")
171    (934 "Upphi" "Phi")
172    (936 "Uppsi" "Psi")
173    (945 "upalpha" "alpha")
174    (946 "upbeta" "beta")
175    (947 "upgamma" "gamma")
176    (948 "updelta" "delta")
177    (949 "upvarepsilon" "varepsilon")
178    (950 "upzeta" "zeta")
179    (951 "upeta" "eta")
180    (952 "uptheta" "theta")
181    (953 "upiota" "iota")
182    (954 "upkappa" "varkappa" "kappa")
183    (955 "uplambda" "lambda")
184    (957 "upnu" "nu")
185    (958 "upxi" "xi")
186    (960 "uppi" "pi")
187    (961 "upvarrho" "uprho" "rho")
188    (962 "varsigma")
189    (963 "upvarsigma" "upsigma" "sigma")
190    (964 "uptau" "tau")
191    (965 "upupsilon" "upsilon")
192    (966 "upphi" "phi")
193    (967 "upchi" "chi")
194    (968 "uppsi" "psi")
195    (969 "upomega" "omega")
196    (977 "upvartheta" "vartheta")
197    (981 "upvarphi" "varphi")
198    (8224 "dagger")
199    (8225 "ddagger")
200    (8226 "bullet")
201    (8486 "Upomega" "Omega")
202    (8501 "aleph")
203    (8592 "mapsfrom" "leftarrow")
204    (8593 "uparrow")
205    (8594 "to" "mapsto" "rightarrow")
206    (8595 "downarrow")
207    (8596 "leftrightarrow")
208    (8656 "shortleftarrow" "Leftarrow")
209    (8657 "Uparrow")
210    (8658 "Mapsto" "rightrightarrows" "Rightarrow")
211    (8659 "Downarrow")
212    (8660 "Leftrightarrow")
213    (8704 "forall")
214    (8706 "partial")
215    (8707 "exists")
216    (8709 "varnothing" "emptyset")
217    (8710 "Updelta" "Delta")
218    (8711 "nabla")
219    (8712 "in")
220    (8722 "-")
221    (8725 "setminus")
222    (8727 "*")
223    (8734 "infty")
224    (8743 "wedge")
225    (8744 "vee")
226    (8745 "cap")
227    (8746 "cup")
228    (8756 "therefore")
229    (8757 "because")
230    (8764 "thicksim" "sim")
231    (8776 "thickapprox" "approx")
232    (8801 "equiv")
233    (8804 "leq")
234    (8805 "geq")
235    (8810 "lll")
236    (8811 "ggg")
237    (8814 "nless")
238    (8815 "ngtr")
239    (8822 "lessgtr")
240    (8823 "gtrless")
241    (8826 "prec")
242    (8832 "nprec")
243    (8834 "subset")
244    (8835 "supset")
245    (8838 "subseteq")
246    (8839 "supseteq")
247    (8853 "oplus")
248    (8855 "otimes")
249    (8869 "bot" "perp")
250    (9702 "circ")
251    (9792 "female" "venus")
252    (9793 "earth")
253    (9794 "male" "mars")
254    (9824 "spadesuit")
255    (9827 "clubsuit")
256    (9829 "heartsuit")
257    (9830 "diamondsuit"))
258  "Alist mapping PDF character to a list of LaTeX macro names.
259
260Adding a character here with it's LaTeX equivalent names allows
261the heuristic backward search to find it's location in the source
262file.  These strings should not match
263`pdf-sync-backward-source-flush-regexp'.
264
265Has no effect if `pdf-sync-backward-use-heuristic' is nil."
266  :group 'pdf-sync
267  :type '(alist :key-type character
268                :value-type (repeat string)))
269
270(defconst pdf-sync-backward-text-flush-regexp
271  "[][.·{}|\\]\\|\\C.\\|-\n+"
272  "Regexp of ignored text when backward searching.")
273
274(defconst pdf-sync-backward-source-flush-regexp
275  "\\(?:\\\\\\(?:begin\\|end\\|\\(?:eq\\)?ref\\|label\\|cite\\){[^}]*}\\)\\|[][\\&{}$_]"
276  "Regexp of ignored source when backward searching.")
277
278(defconst pdf-sync-backward-context-limit 64
279  "Number of character to include in the backward search.")
280
281(defun pdf-sync-backward-search-mouse (ev)
282  "Go to the source corresponding to position at event EV."
283  (interactive "@e")
284  (let* ((posn (event-start ev))
285         (image (posn-image posn))
286         (xy (posn-object-x-y posn)))
287    (unless image
288      (error "Outside of image area"))
289    (pdf-sync-backward-search (car xy) (cdr xy))))
290
291(defun pdf-sync-backward-search (x y)
292  "Go to the source corresponding to image coordinates X, Y.
293
294Try to find the exact position, if
295`pdf-sync-backward-use-heuristic' is non-nil."
296  (cl-destructuring-bind (source finder)
297      (pdf-sync-backward-correlate x y)
298    (pop-to-buffer (or (find-buffer-visiting source)
299                       (find-file-noselect source))
300                   pdf-sync-backward-display-action)
301    (push-mark)
302    (funcall finder)
303    (run-hooks 'pdf-sync-backward-hook)))
304
305(defun pdf-sync-backward-correlate (x y)
306  "Find the source corresponding to image coordinates X, Y.
307
308Returns a list \(SOURCE FINDER\), where SOURCE is the name of the
309TeX file and FINDER a function of zero arguments which, when
310called in the buffer of the aforementioned file, will try to move
311point to the correct position."
312
313  (pdf-util-assert-pdf-window)
314  (let ((size (pdf-view-image-size))
315        (page (pdf-view-current-page)))
316    (setq x (/ x (float (car size)))
317          y (/ y (float (cdr size))))
318    (let-alist (pdf-info-synctex-backward-search page x y)
319      (let ((data (list (expand-file-name .filename)
320                        .line .column)))
321        (cl-destructuring-bind (source line column)
322            (or (save-selected-window
323                  (apply 'run-hook-with-args-until-success
324                    'pdf-sync-backward-redirect-functions data))
325                data)
326          (list source
327                (if (not pdf-sync-backward-use-heuristic)
328                    (lambda nil
329                      (pdf-util-goto-position line column))
330                  (let ((context (pdf-sync-backward--get-text-context page x y)))
331                    (lambda nil
332                      (pdf-sync-backward--find-position line column context))))))))))
333
334(defun pdf-sync-backward--find-position (line column context)
335  (pdf-util-goto-position line column)
336  (cl-destructuring-bind (windex chindex words)
337      context
338    (let* ((swords (pdf-sync-backward--get-source-context
339                    nil (* 6 pdf-sync-backward-context-limit)))
340           (similarity-fn (lambda (text source)
341                            (if (if (consp text)
342                                    (member source text)
343                                  (equal text source))
344                                1024 -1024)))
345           (alignment
346            (pdf-util-seq-alignment
347             words swords similarity-fn 'infix)))
348      (setq alignment (cl-remove-if-not 'car (cdr alignment)))
349      (cl-assert (< windex (length alignment)))
350
351      (let ((word (cdr (nth windex alignment))))
352        (unless word
353          (setq chindex 0
354                word (cdr (nth (1+ windex) alignment))))
355        (unless word
356          (setq word (cdr (nth (1- windex) alignment))
357                chindex (length word)))
358        (when word
359          (cl-assert (get-text-property 0 'position word) t)
360          (goto-char (get-text-property 0 'position word))
361          (forward-char chindex))))))
362
363(defun pdf-sync-backward--get-source-context (&optional position limit)
364  (save-excursion
365    (when position (goto-char position))
366    (goto-char (line-beginning-position))
367    (let* ((region
368            (cond
369             ((eq limit 'line)
370              (cons (line-beginning-position)
371                    (line-end-position)))
372
373             ;; Synctex usually jumps to the end macro, in case it
374             ;; does not understand the environment.
375             ((and (fboundp 'LaTeX-find-matching-begin)
376                   (looking-at " *\\\\\\(end\\){"))
377              (cons (or (ignore-errors
378                          (save-excursion
379                            (LaTeX-find-matching-begin)
380                            (forward-line 1)
381                            (point)))
382                        (point))
383                    (point)))
384             ((and (fboundp 'LaTeX-find-matching-end)
385                   (looking-at " *\\\\\\(begin\\){"))
386              (goto-char (line-end-position))
387              (cons (point)
388                    (or (ignore-errors
389                          (save-excursion
390                            (LaTeX-find-matching-end)
391                            (forward-line 0)
392                            (point)))
393                        (point))))
394             (t (cons (point) (point)))))
395           (begin (car region))
396           (end (cdr region)))
397      (when (numberp limit)
398        (let ((delta (- limit (- end begin))))
399          (when (> delta 0)
400            (setq begin (max (point-min)
401                             (- begin (/ delta 2)))
402                  end (min (point-max)
403                           (+ end (/ delta 2)))))))
404      (let ((string (buffer-substring-no-properties begin end)))
405        (dotimes (i (length string))
406          (put-text-property i (1+ i) 'position (+ begin i) string))
407        (nth 2 (pdf-sync-backward--tokenize
408                (pdf-sync-backward--source-strip-comments string)
409                nil
410                pdf-sync-backward-source-flush-regexp))))))
411
412(defun pdf-sync-backward--source-strip-comments (string)
413  "Strip all standard LaTeX comments from string."
414  (with-temp-buffer
415    (save-excursion (insert string))
416    (while (re-search-forward
417            "^\\(?:[^\\\n]\\|\\(?:\\\\\\\\\\)\\)*\\(%.*\\)" nil t)
418      (delete-region (match-beginning 1) (match-end 1)))
419    (buffer-string)))
420
421(defun pdf-sync-backward--get-text-context (page x y)
422  (cl-destructuring-bind (&optional char edges)
423      (car (pdf-info-charlayout page (cons x y)))
424    (when edges
425      (setq x (nth 0 edges)
426            y (nth 1 edges)))
427    (let* ((prefix (pdf-info-gettext page (list 0 0 x y)))
428           (suffix (pdf-info-gettext page (list x y 1 1)))
429           (need-suffix-space-p (memq char '(?\s ?\n)))
430           ;; Figure out whether we missed a space by matching the
431           ;; prefix's suffix with the line's prefix.  Due to the text
432           ;; extraction in poppler, spaces are only inserted in
433           ;; between words.  This test may fail, if prefix and line
434           ;; do not overlap, which may happen in various cases, but
435           ;; we don't care.
436           (need-prefix-space-p
437            (and (not need-suffix-space-p)
438                 (memq
439                  (ignore-errors
440                    (aref (pdf-info-gettext page (list x y x y) 'line)
441                          (- (length prefix)
442                             (or (cl-position ?\n prefix :from-end t)
443                                 -1)
444                             1)))
445                  '(?\s ?\n)))))
446      (setq prefix
447            (concat
448             (substring
449              prefix (max 0 (min (1- (length prefix))
450                                 (- (length prefix)
451                                    pdf-sync-backward-context-limit))))
452             (if need-prefix-space-p " "))
453            suffix
454            (concat
455             (if need-suffix-space-p " ")
456             (substring
457              suffix 0 (max 0 (min (1- (length suffix))
458                                   pdf-sync-backward-context-limit)))))
459      (pdf-sync-backward--tokenize
460       prefix suffix
461       pdf-sync-backward-text-flush-regexp
462       pdf-sync-backward-text-translations))))
463
464(defun pdf-sync-backward--tokenize (prefix &optional suffix flush-re translation)
465  (with-temp-buffer
466    (when prefix (insert prefix))
467    (let* ((center (copy-marker (point)))
468           (case-fold-search nil))
469      (when suffix (insert suffix))
470      (goto-char 1)
471      ;; Delete ignored text.
472      (when flush-re
473        (save-excursion
474          (while (re-search-forward flush-re nil t)
475            (replace-match " " t t))))
476      ;; Normalize whitespace.
477      (save-excursion
478        (while (re-search-forward "[ \t\f\n]+" nil t)
479          (replace-match " " t t)))
480      ;; Split words and non-words
481      (save-excursion
482        (while (re-search-forward "[^ ]\\b\\|[^ [:alnum:]]" nil t)
483          (insert-before-markers " ")))
484      ;; Replace character
485      (let ((translate
486             (lambda (string)
487               (or (and (= (length string) 1)
488                        (cdr (assq (aref string 0)
489                                   translation)))
490                   string)))
491            words
492            (windex -1)
493            (chindex 0))
494        (skip-chars-forward " ")
495        (while (and (not (eobp))
496                    (<= (point) center))
497          (cl-incf windex)
498          (skip-chars-forward "^ ")
499          (skip-chars-forward " "))
500        (goto-char center)
501        (when (eq ?\s (char-after))
502          (skip-chars-backward " "))
503        (setq chindex (- (skip-chars-backward "^ ")))
504        (setq words (split-string (buffer-string)))
505        (when translation
506          (setq words (mapcar translate words)))
507        (list windex chindex words)))))
508
509(defun pdf-sync-backward-beginning-of-word ()
510  "Maybe move to the beginning of the word.
511
512Don't move if already at the beginning, or if not at a word
513character.
514
515This function is meant to be put on `pdf-sync-backward-hook', when
516word-level searching is desired."
517  (interactive)
518  (unless (or (looking-at "\\b\\w")
519              (not (looking-back "\\w" (1- (point)))))
520    (backward-word)))
521
522;; * ------------------------------------------------------------------ *
523;; * Debugging backward search
524;; * ------------------------------------------------------------------ *
525
526(defvar pdf-sync-backward-debug-trace nil)
527
528(defun pdf-sync-backward-debug-wrapper (fn-symbol fn &rest args)
529  (cond
530   ((eq fn-symbol 'pdf-sync-backward-search)
531    (setq pdf-sync-backward-debug-trace nil)
532    (apply fn args))
533   (t
534    (let ((retval (apply fn args)))
535      (push `(,args . ,retval)
536            pdf-sync-backward-debug-trace)
537      retval))))
538
539(define-minor-mode pdf-sync-backward-debug-minor-mode
540  "Aid in debugging the backward search."
541  :group 'pdf-sync
542  (if (and (fboundp 'advice-add)
543           (fboundp 'advice-remove))
544      (let ((functions
545             '(pdf-sync-backward-search
546               pdf-sync-backward--tokenize
547               pdf-util-seq-alignment)))
548        (cond
549         (pdf-sync-backward-debug-minor-mode
550          (dolist (fn functions)
551            (advice-add fn :around (apply-partially 'pdf-sync-backward-debug-wrapper
552                                                    fn)
553                        `((name . ,(format "%s-debug" fn))))))
554         (t
555          (dolist (fn functions)
556            (advice-remove fn (format "%s-debug" fn))))))
557    (error "Need Emacs version >= 24.4")))
558
559(defun pdf-sync-backward-debug-explain ()
560  "Explain the last backward search.
561
562Needs to have `pdf-sync-backward-debug-minor-mode' enabled."
563
564  (interactive)
565  (unless pdf-sync-backward-debug-trace
566    (error "No last search or `pdf-sync-backward-debug-minor-mode' not enabled."))
567
568  (with-current-buffer (get-buffer-create "*pdf-sync-backward trace*")
569    (cl-destructuring-bind (text source alignment &rest ignored)
570        (reverse pdf-sync-backward-debug-trace)
571      (let* ((fill-column 68)
572             (sep (format "\n%s\n" (make-string fill-column ?-)))
573             (highlight '(:background "chartreuse" :foreground "black"))
574             (or-sep "|")
575             (inhibit-read-only t)
576             (windex (nth 0 (cdr text)))
577             (chindex (nth 1 (cdr text))))
578        (erase-buffer)
579        (font-lock-mode -1)
580        (view-mode 1)
581        (insert (propertize "Text Raw:" 'face 'font-lock-keyword-face))
582        (insert sep)
583        (insert (nth 0 (car text)))
584        (insert (propertize "<|>" 'face highlight))
585        (insert (nth 1 (car text)))
586        (insert sep)
587        (insert (propertize "Text Token:" 'face 'font-lock-keyword-face))
588        (insert sep)
589        (fill-region (point)
590                     (progn
591                       (insert
592                        (mapconcat (lambda (elt)
593                                     (if (consp elt)
594                                         (mapconcat 'identity elt or-sep)
595                                       elt))
596                                   (nth 2 (cdr text)) " "))
597                       (point)))
598        (insert sep)
599
600        (insert (propertize "Source Raw:" 'face 'font-lock-keyword-face))
601        (insert sep)
602        (insert (nth 0 (car source)))
603        (insert sep)
604        (insert (propertize "Source Token:" 'face 'font-lock-keyword-face))
605        (insert sep)
606        (fill-region (point)
607                     (progn (insert (mapconcat 'identity (nth 2 (cdr source)) " "))
608                            (point)))
609        (insert sep)
610
611        (insert (propertize "Alignment:" 'face 'font-lock-keyword-face))
612        (insert (format " (windex=%d, chindex=%d" windex chindex))
613        (insert sep)
614        (save-excursion (newline 2))
615        (let ((column 0)
616              (index 0))
617          (dolist (a (cdr (cdr alignment)))
618            (let* ((source (cdr a))
619                   (text (if (consp (car a))
620                             (mapconcat 'identity (car a) or-sep)
621                           (car a)))
622                   (extend (max (length text)
623                                (length source))))
624              (when (and (not (bolp))
625                         (> (+ column extend)
626                            fill-column))
627                (forward-line 2)
628                (newline 3)
629                (forward-line -2)
630                (setq column 0))
631              (when text
632                (insert (propertize text 'face
633                                    (if (= index windex)
634                                        highlight
635                                      (if source 'match
636                                        'lazy-highlight)))))
637              (move-to-column (+ column extend) t)
638              (insert " ")
639              (save-excursion
640                (forward-line)
641                (move-to-column column t)
642                (when source
643                  (insert (propertize source 'face (if text
644                                                       'match
645                                                     'lazy-highlight))))
646                (move-to-column (+ column extend) t)
647                (insert " "))
648              (cl-incf column (+ 1 extend))
649              (when text (cl-incf index)))))
650        (goto-char (point-max))
651        (insert sep)
652        (goto-char 1)
653        (pop-to-buffer (current-buffer))))))
654
655
656;; * ================================================================== *
657;; * Forward search (TeX -> PDF)
658;; * ================================================================== *
659
660(defun pdf-sync-forward-search (&optional line column)
661  "Display the PDF location corresponding to LINE, COLUMN."
662  (interactive)
663  (cl-destructuring-bind (pdf page _x1 y1 _x2 _y2)
664      (pdf-sync-forward-correlate line column)
665    (let ((buffer (or (find-buffer-visiting pdf)
666                      (find-file-noselect pdf))))
667      (with-selected-window (display-buffer
668                             buffer pdf-sync-forward-display-action)
669        (pdf-util-assert-pdf-window)
670        (when page
671	  (pdf-view-goto-page page)
672	  (when y1
673	    (let ((top (* y1 (cdr (pdf-view-image-size)))))
674	      (pdf-util-tooltip-arrow (round top))))))
675      (with-current-buffer buffer
676        (run-hooks 'pdf-sync-forward-hook)))))
677
678(defun pdf-sync-forward-correlate (&optional line column)
679  "Find the PDF location corresponding to LINE, COLUMN.
680
681Returns a list \(PDF PAGE X1 Y1 X2 Y2\), where PAGE, X1, Y1, X2
682and Y2 may be nil, if the destination could not be found."
683  (unless (fboundp 'TeX-master-file)
684    (error "This function works only with AUCTeX"))
685  (unless line (setq line (line-number-at-pos)))
686  (unless column (setq column (current-column)))
687
688  (let* ((pdf (expand-file-name
689               (with-no-warnings (TeX-master-file "pdf"))))
690         (sfilename (pdf-sync-synctex-file-name
691                     (buffer-file-name) pdf)))
692    (cons pdf
693	  (condition-case error
694	      (let-alist (pdf-info-synctex-forward-search
695			  (or sfilename
696			      (buffer-file-name))
697			  line column pdf)
698		(cons .page .edges))
699	    (error
700	     (message "%s" (error-message-string error))
701	     (list nil nil nil nil nil))))))
702
703
704
705;; * ================================================================== *
706;; * Dealing with synctex files.
707;; * ================================================================== *
708
709(defun pdf-sync-locate-synctex-file (pdffile)
710  "Locate the synctex database corresponding to PDFFILE.
711
712Returns either the absolute path of the database or nil.
713
714See also `pdf-sync-locate-synctex-file-functions'."
715  (cl-check-type pdffile string)
716  (setq pdffile (expand-file-name pdffile))
717  (or (run-hook-with-args-until-success
718       'pdf-sync-locate-synctex-file-functions pdffile)
719      (pdf-sync-locate-synctex-file-default pdffile)))
720
721(defun pdf-sync-locate-synctex-file-default (pdffile)
722  "The default function for locating a synctex database for PDFFILE.
723
724See also `pdf-sync-locate-synctex-file'."
725  (let ((default-directory
726          (file-name-directory pdffile))
727        (basename (file-name-sans-extension
728                   (file-name-nondirectory pdffile))))
729    (cl-labels ((file-if-exists-p (file)
730                  (and (file-exists-p file)
731                       file)))
732      (or (file-if-exists-p
733           (expand-file-name (concat basename ".synctex.gz")))
734          (file-if-exists-p
735           (expand-file-name (concat basename ".synctex")))
736          ;; Some pdftex quote the basename.
737          (file-if-exists-p
738           (expand-file-name (concat "\"" basename "\"" ".synctex.gz")))
739          (file-if-exists-p
740           (expand-file-name (concat "\"" basename "\"" ".synctex")))))))
741
742(defun pdf-sync-synctex-file-name (filename pdffile)
743  "Find SyncTeX filename corresponding to FILENAME in the context of PDFFILE.
744
745This function consults the synctex.gz database of PDFFILE and
746searches for a filename, which is `file-equal-p' to FILENAME.
747The first such filename is returned, or nil if none was found."
748
749  (when (file-exists-p filename)
750    (setq filename (expand-file-name filename))
751    (let* ((synctex (pdf-sync-locate-synctex-file pdffile))
752           (basename (file-name-nondirectory filename))
753           (regexp (format "^ *Input *: *[^:\n]+ *:\\(.*%s\\)$"
754                           (regexp-quote basename)))
755           (jka-compr-verbose nil))
756      (when (and synctex
757                 (file-readable-p synctex))
758        (with-current-buffer (find-file-noselect synctex :nowarn)
759          (unless (or (verify-visited-file-modtime)
760                      (buffer-modified-p))
761            (revert-buffer :ignore-auto :noconfirm)
762            (goto-char (point-min)))
763          ;; Keep point in front of the found filename. It will
764          ;; probably be queried for again next time.
765          (let ((beg (point))
766                (end (point-max)))
767            (catch 'found
768              (dotimes (_x 2)
769                (while (re-search-forward regexp end t)
770                  (let ((syncname (match-string-no-properties 1)))
771                    (when (and (file-exists-p syncname)
772                               (file-equal-p filename syncname))
773                      (goto-char (point-at-bol))
774                      (throw 'found syncname))))
775                (setq end beg
776                      beg (point-min))
777                (goto-char beg)))))))))
778
779(provide 'pdf-sync)
780;;; pdf-sync.el ends here
781