1;;; reftex-parse.el --- parser functions for RefTeX
2
3;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
4;;   2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Carsten Dominik <dominik@science.uva.nl>
7;; Maintainer: auctex-devel@gnu.org
8;; Version: 4.31
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING.  If not, write to the
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
26
27;;; Commentary:
28
29;;; Code:
30
31(eval-when-compile (require 'cl))
32(provide 'reftex-parse)
33(require 'reftex)
34
35(defmacro reftex-with-special-syntax (&rest body)
36  `(let ((saved-syntax (syntax-table)))
37     (unwind-protect
38         (progn
39           (set-syntax-table reftex-syntax-table)
40           (let ((case-fold-search nil))
41             ,@body))
42       (set-syntax-table saved-syntax))))
43
44(defun reftex-parse-one ()
45  "Re-parse this file."
46  (interactive)
47  (let ((reftex-enable-partial-scans t))
48    (reftex-access-scan-info '(4))))
49
50(defun reftex-parse-all ()
51  "Re-parse entire document."
52  (interactive)
53  (reftex-access-scan-info '(16)))
54
55(defun reftex-do-parse (rescan &optional file)
56  "Do a document rescan.  When allowed, do only a partial scan from FILE."
57
58  ;; Normalize the rescan argument
59  (setq rescan (cond ((eq rescan t) t)
60                     ((eq rescan 1) 1)
61                     ((equal rescan '(4)) t)
62                     ((equal rescan '(16)) 1)
63                     (t 1)))
64
65  ;; Partial scans only when allowed
66  (unless reftex-enable-partial-scans
67    (setq rescan 1))
68
69  ;; Do the scanning.
70
71  (let* ((old-list (symbol-value reftex-docstruct-symbol))
72         (master (reftex-TeX-master-file))
73         (true-master (file-truename master))
74         (master-dir (file-name-as-directory (file-name-directory master)))
75         (file (or file (buffer-file-name)))
76         (true-file (file-truename file))
77         (bibview-cache (assq 'bibview-cache old-list))
78         (index-tags (cdr (assq 'index-tags old-list)))
79         from-file appendix docstruct tmp)
80
81    ;; Make sure replacement is really an option here
82    (when (and (eq rescan t)
83               (not (and (member (list 'bof file) old-list)
84                         (member (list 'eof file) old-list))))
85      ;; Scan whole document because no such file section exists
86      (setq rescan 1))
87    (when (string= true-file true-master)
88      ;; Scan whole document because this file is the master
89      (setq rescan 1))
90
91    ;; From which file do we start?
92    (setq from-file
93          (cond ((eq rescan t) (or file master))
94                ((eq rescan 1) master)
95                (t (error "This should not happen (reftex-do-parse)"))))
96
97    ;; Reset index-tags if we scan everything
98    (if (equal rescan 1) (setq index-tags nil))
99
100    ;; Find active toc entry and initialize section-numbers
101    (setq reftex-active-toc (reftex-last-assoc-before-elt
102                             'toc (list 'bof from-file) old-list)
103          appendix (reftex-last-assoc-before-elt
104                    'appendix (list 'bof from-file) old-list))
105
106    (reftex-init-section-numbers reftex-active-toc appendix)
107
108    (if (eq rescan 1)
109        (message "Scanning entire document...")
110      (message "Scanning document from %s..." from-file))
111
112    (reftex-with-special-syntax
113     (save-window-excursion
114       (save-excursion
115         (unwind-protect
116             (setq docstruct
117                   (reftex-parse-from-file
118                    from-file docstruct master-dir))
119           (reftex-kill-temporary-buffers)))))
120
121    (message "Scanning document... done")
122
123    ;; Turn the list around.
124    (setq docstruct (nreverse docstruct))
125
126    ;; Set or insert
127    (setq docstruct (reftex-replace-label-list-segment
128                     old-list docstruct (eq rescan 1)))
129
130    ;; Add all missing information
131    (unless (assq 'label-numbers docstruct)
132      (push (cons 'label-numbers nil) docstruct))
133    (unless (assq 'master-dir docstruct)
134      (push (cons 'master-dir master-dir) docstruct))
135    (unless (assq 'bibview-cache docstruct)
136      (push (cons 'bibview-cache (cdr bibview-cache)) docstruct))
137    (let* ((bof1 (memq (assq 'bof docstruct) docstruct))
138           (bof2 (assq 'bof (cdr bof1)))
139           (is-multi (not (not (and bof1 bof2))))
140           (entry (or (assq 'is-multi docstruct)
141                      (car (push (list 'is-multi is-multi) docstruct)))))
142      (setcdr entry (cons is-multi nil)))
143    (and index-tags (setq index-tags (sort index-tags 'string<)))
144    (let ((index-tag-cell (assq 'index-tags docstruct)))
145      (if index-tag-cell
146          (setcdr index-tag-cell index-tags)
147        (push (cons 'index-tags index-tags) docstruct)))
148    (unless (assq 'xr docstruct)
149      (let* ((allxr (reftex-all-assq 'xr-doc docstruct))
150             (alist (mapcar
151                     (lambda (x)
152                       (if (setq tmp (reftex-locate-file (nth 2 x) "tex"
153                                                         master-dir))
154                           (cons (nth 1 x) tmp)
155                         (message "Can't find external document %s"
156                                  (nth 2 x))
157                         nil))
158                     allxr))
159             (alist (delq nil alist))
160             (allprefix (delq nil (mapcar 'car alist)))
161             (regexp (if allprefix
162                         (concat "\\`\\("
163                                 (mapconcat 'identity allprefix "\\|")
164                                 "\\)")
165                       "\\\\\\\\\\\\")))   ; this will never match
166        (push (list 'xr alist regexp) docstruct)))
167
168    (set reftex-docstruct-symbol docstruct)
169    (put reftex-docstruct-symbol 'modified t)))
170
171(defun reftex-everything-regexp ()
172  (if reftex-support-index
173      reftex-everything-regexp
174    reftex-everything-regexp-no-index))
175
176;;;###autoload
177(defun reftex-all-document-files (&optional relative)
178  "Return a list of all files belonging to the current document.
179When RELATIVE is non-nil, give file names relative to directory
180of master file."
181  (let* ((all (symbol-value reftex-docstruct-symbol))
182         (master-dir (file-name-directory (reftex-TeX-master-file)))
183         (re (concat "\\`" (regexp-quote master-dir)))
184        file-list tmp file)
185    (while (setq tmp (assoc 'bof all))
186      (setq file (nth 1 tmp)
187            all (cdr (memq tmp all)))
188      (and relative
189           (string-match re file)
190           (setq file (substring file (match-end 0))))
191      (push file file-list))
192    (nreverse file-list)))
193
194(defun reftex-parse-from-file (file docstruct master-dir)
195  ;; Scan the buffer for labels and save them in a list.
196  (let ((regexp (reftex-everything-regexp))
197        (bound 0)
198        file-found tmp include-file
199        (level 1)
200        (highest-level 100)
201        toc-entry index-entry next-buf buf)
202
203    (catch 'exit
204      (setq file-found (reftex-locate-file file "tex" master-dir))
205      (if (and (not file-found)
206               (setq buf (reftex-get-buffer-visiting file)))
207          (setq file-found (buffer-file-name buf)))
208
209      (unless file-found
210        (push (list 'file-error file) docstruct)
211        (throw 'exit nil))
212
213      (save-excursion
214
215        (message "Scanning file %s" file)
216        (set-buffer
217         (setq next-buf
218               (reftex-get-file-buffer-force
219                file-found
220                (not (eq t reftex-keep-temporary-buffers)))))
221
222        ;; Begin of file mark
223        (setq file (buffer-file-name))
224        (push (list 'bof file) docstruct)
225
226        (reftex-with-special-syntax
227         (save-excursion
228           (save-restriction
229             (widen)
230             (goto-char 1)
231
232             (while (re-search-forward regexp nil t)
233
234               (cond
235
236                ((match-end 1)
237                 ;; It is a label
238                 (push (reftex-label-info (reftex-match-string 1) file bound)
239                       docstruct))
240
241                ((match-end 3)
242                 ;; It is a section
243                 (setq bound (point))
244
245                 ;; Insert in List
246                 (setq toc-entry (reftex-section-info file))
247                 (when toc-entry
248                   ;; It can happen that section info returns nil
249                   (setq level (nth 5 toc-entry))
250                   (setq highest-level (min highest-level level))
251                   (if (= level highest-level)
252                       (message
253                        "Scanning %s %s ..."
254                        (car (rassoc level reftex-section-levels-all))
255                        (nth 6 toc-entry)))
256
257                   (push toc-entry docstruct)
258                   (setq reftex-active-toc toc-entry)))
259
260                ((match-end 7)
261                 ;; It's an include or input
262                 (setq include-file (reftex-match-string 7))
263                 ;; Test if this file should be ignored
264                 (unless (delq nil (mapcar
265                                    (lambda (x) (string-match x include-file))
266                                    reftex-no-include-regexps))
267                   ;; Parse it
268                   (setq docstruct
269                         (reftex-parse-from-file
270                          include-file
271                          docstruct master-dir))))
272
273                ((match-end 9)
274                 ;; Appendix starts here
275                 (reftex-init-section-numbers nil t)
276                 (push (cons 'appendix t) docstruct))
277
278                ((match-end 10)
279                 ;; Index entry
280                 (when reftex-support-index
281                   (setq index-entry (reftex-index-info file))
282                   (when index-entry
283                     (add-to-list 'index-tags (nth 1 index-entry))
284                     (push index-entry docstruct))))
285
286                ((match-end 11)
287                 ;; A macro with label
288                 (save-excursion
289                   (let* ((mac (reftex-match-string 11))
290                          (label (progn (goto-char (match-end 11))
291                                        (save-match-data
292                                          (reftex-no-props
293                                           (reftex-nth-arg-wrapper
294                                            mac)))))
295                          (typekey (nth 1 (assoc mac reftex-env-or-mac-alist)))
296                          (entry (progn (if typekey
297                                            ;; A typing macro
298                                            (goto-char (match-end 0))
299                                          ;; A neutral macro
300                                          (goto-char (match-end 11))
301                                          (reftex-move-over-touching-args))
302                                        (reftex-label-info
303                                         label file bound nil nil))))
304                     (push entry docstruct))))
305                (t (error "This should not happen (reftex-parse-from-file)")))
306               )
307
308             ;; Find bibliography statement
309             (when (setq tmp (reftex-locate-bibliography-files master-dir))
310               (push (cons 'bib tmp) docstruct))
311
312             (goto-char 1)
313             (when (re-search-forward
314                    "\\(\\`\\|[\n\r]\\)[ \t]*\\\\begin{thebibliography}" nil t)
315               (push (cons 'thebib file) docstruct))
316
317             ;; Find external document specifications
318             (goto-char 1)
319             (while (re-search-forward "[\n\r][ \t]*\\\\externaldocument\\(\\[\\([^]]*\\)\\]\\)?{\\([^}]+\\)}" nil t)
320               (push (list 'xr-doc (reftex-match-string 2)
321                           (reftex-match-string 3))
322                     docstruct))
323
324             ;; End of file mark
325             (push (list 'eof file) docstruct)))))
326
327      ;; Kill the scanned buffer
328      (reftex-kill-temporary-buffers next-buf))
329
330    ;; Return the list
331    docstruct))
332
333(defun reftex-locate-bibliography-files (master-dir &optional files)
334  ;; Scan buffer for bibliography macro and return file list.
335
336  (unless files
337    (save-excursion
338      (goto-char (point-min))
339      (if (re-search-forward
340           (concat
341;           "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\("
342            "\\(^\\)[^%\n\r]*\\\\\\("
343            (mapconcat 'identity reftex-bibliography-commands "\\|")
344            "\\){[ \t]*\\([^}]+\\)") nil t)
345          (setq files
346                (split-string (reftex-match-string 3)
347                              "[ \t\n\r]*,[ \t\n\r]*")))))
348  (when files
349    (setq files
350          (mapcar
351           (lambda (x)
352             (if (or (member x reftex-bibfile-ignore-list)
353                     (delq nil (mapcar (lambda (re) (string-match re x))
354                                       reftex-bibfile-ignore-regexps)))
355                 ;; excluded file
356                 nil
357               ;; find the file
358               (reftex-locate-file x "bib" master-dir)))
359           files))
360    (delq nil files)))
361
362(defun reftex-replace-label-list-segment (old insert &optional entirely)
363  ;; Replace the segment in OLD which corresponds to INSERT.
364  ;; Works with side effects, directly changes old.
365  ;; If entirely is t, just return INSERT.
366  ;; This function also makes sure the old toc markers do not point anywhere.
367
368  (cond
369   (entirely
370    (reftex-silence-toc-markers old (length old))
371    insert)
372   (t (let* ((new old)
373             (file (nth 1 (car insert)))
374             (eof-list (member (list 'eof file) old))
375             (bof-list (member (list 'bof file) old))
376             n)
377        (if (not (and bof-list eof-list))
378            (error "Cannot splice")
379          ;; Splice
380          (reftex-silence-toc-markers bof-list (- (length bof-list)
381                                                  (length eof-list)))
382          (setq n (- (length old) (length bof-list)))
383          (setcdr (nthcdr n new) (cdr insert))
384          (setcdr (nthcdr (1- (length new)) new) (cdr eof-list)))
385        new))))
386
387(defun reftex-section-info (file)
388  ;; Return a section entry for the current match.
389  ;; Carefull: This function expects the match-data to be still in place!
390  (let* ((marker (set-marker (make-marker) (1- (match-beginning 3))))
391         (macro (reftex-match-string 3))
392         (prefix (save-match-data
393                   (if (string-match "begin{\\([^}]+\\)}" macro)
394                       (match-string 1 macro))))
395         (level-exp (cdr (assoc macro reftex-section-levels-all)))
396         (level (if (symbolp level-exp)
397                    (save-match-data (funcall level-exp))
398                  level-exp))
399         (star (= ?* (char-after (match-end 3))))
400         (unnumbered (or star (< level 0)))
401         (level (abs level))
402         (section-number (reftex-section-number level unnumbered))
403         (text1 (save-match-data
404                  (save-excursion
405                    (reftex-context-substring prefix))))
406         (literal (buffer-substring-no-properties
407                   (1- (match-beginning 3))
408                   (min (point-max) (+ (match-end 0) (length text1) 1))))
409         ;; Literal can be too short since text1 too short. No big problem.
410         (text (reftex-nicify-text text1)))
411
412    ;; Add section number and indentation
413    (setq text
414          (concat
415           (make-string (* reftex-level-indent level) ?\ )
416           (if (nth 1 reftex-label-menu-flags) ; section number flag
417               (concat section-number " "))
418           (if prefix (concat (capitalize prefix) ": ") "")
419           text))
420    (list 'toc "toc" text file marker level section-number
421          literal (marker-position marker))))
422
423(defun reftex-ensure-index-support (&optional abort)
424  ;; When index support is turned off, ask to turn it on and
425  ;; set the current prefix argument so that `reftex-access-scan-info'
426  ;; will rescan the entire document.
427  (cond
428   (reftex-support-index t)
429   ((y-or-n-p "Turn on index support and rescan entire document? ")
430    (setq reftex-support-index 'demanded
431          current-prefix-arg '(16)))
432   (t (if abort
433          (error "No index support")
434        (message "No index support")
435        (ding)
436        (sit-for 1)))))
437
438(defun reftex-index-info-safe (file)
439  (reftex-with-special-syntax
440   (reftex-index-info file)))
441
442(defvar test-dummy)
443(defun reftex-index-info (file)
444  ;; Return an index entry for the current match.
445  ;; Carefull: This function expects the match-data to be still in place!
446  (catch 'exit
447    (let* ((macro (reftex-match-string 10))
448           (bom (match-beginning 10))
449           (boa (match-end 10))
450           (entry (or (assoc macro reftex-index-macro-alist)
451                      (throw 'exit nil)))
452           (exclude (nth 3 entry))
453           ;; The following is a test if this match should be excluded
454           (test-dummy (and (fboundp exclude)
455                            (funcall exclude)
456                            (throw 'exit nil)))
457           (itag (nth 1 entry))
458           (prefix (nth 2 entry))
459           (index-tag
460            (cond ((stringp itag) itag)
461                  ((integerp itag)
462                   (progn (goto-char boa)
463                          (or (reftex-nth-arg itag (nth 6 entry)) "idx")))
464                  (t "idx")))
465           (arg (or (progn (goto-char boa)
466                           (reftex-nth-arg (nth 5 entry) (nth 6 entry)))
467                    ""))
468           (end-of-args (progn (goto-char boa)
469                               (reftex-move-over-touching-args)
470                               (point)))
471           (end-of-context (progn (skip-chars-forward "^ \t\n\r") (point)))
472           (begin-of-context
473            (progn (goto-char bom)
474                   (skip-chars-backward "^ \t\r\n")
475                   (point)))
476           (context (buffer-substring-no-properties
477                     begin-of-context end-of-context))
478           (key-end (if (string-match reftex-index-key-end-re arg)
479                        (1+ (match-beginning 0))))
480           (rawkey (substring arg 0 key-end))
481
482           (key (if prefix (concat prefix rawkey) rawkey))
483           (sortkey (downcase key))
484           (showkey (mapconcat 'identity
485                               (split-string key reftex-index-level-re)
486                               " ! ")))
487      (goto-char end-of-args)
488      ;;       0        1       2      3   4   5  6      7       8      9
489      (list 'index index-tag context file bom arg key showkey sortkey key-end))))
490
491(defun reftex-short-context (env parse &optional bound derive)
492  ;; Get about one line of useful context for the label definition at point.
493
494  (if (consp parse)
495      (setq parse (if derive (cdr parse) (car parse))))
496
497  (reftex-nicify-text
498
499   (cond
500
501    ((null parse)
502     (save-excursion
503       (reftex-context-substring)))
504
505    ((eq parse t)
506     (if (string= env "section")
507         ;; special treatment for section labels
508         (save-excursion
509           (if (and (re-search-backward reftex-section-or-include-regexp
510                                        (point-min) t)
511                    (match-end 2))
512               (progn
513                 (goto-char (match-end 0))
514                 (reftex-context-substring))
515             (if reftex-active-toc
516                 (progn
517                   (string-match "{\\([^}]*\\)" (nth 7 reftex-active-toc))
518                   (match-string 1 (nth 7 reftex-active-toc)))
519               "SECTION HEADING NOT FOUND")))
520       (save-excursion
521         (goto-char reftex-default-context-position)
522         (unless (eq (string-to-char env) ?\\)
523           (reftex-move-over-touching-args))
524         (reftex-context-substring))))
525
526    ((stringp parse)
527     (save-excursion
528       (if (re-search-backward parse bound t)
529           (progn
530             (goto-char (match-end 0))
531             (reftex-context-substring))
532         "NO MATCH FOR CONTEXT REGEXP")))
533
534    ((integerp parse)
535     (or (save-excursion
536           (goto-char reftex-default-context-position)
537           (reftex-nth-arg
538            parse
539            (nth 6 (assoc env reftex-env-or-mac-alist))))
540         ""))
541
542    ((fboundp parse)
543     ;; A hook function.  Call it.
544     (save-excursion
545       (condition-case error-var
546           (funcall parse env)
547         (error (format "HOOK ERROR: %s" (cdr error-var))))))
548    (t
549     "INVALID VALUE OF PARSE"))))
550
551(defun reftex-where-am-I ()
552  ;; Return the docstruct entry above point.  Actually returns a cons
553  ;; cell in which the cdr is a flag indicating if the information is
554  ;; exact (t) or approximate (nil).
555
556  (let ((docstruct (symbol-value reftex-docstruct-symbol))
557        (cnt 0) rtn rtn-if-no-other
558        found)
559    (save-excursion
560      (while (not rtn)
561        (incf cnt)
562        (setq found (re-search-backward (reftex-everything-regexp) nil t))
563        (setq rtn
564              (cond
565               ((not found)
566                ;; no match
567                (or
568                 (car (member (list 'bof (buffer-file-name)) docstruct))
569                 (not (setq cnt 2))
570                 (assq 'bof docstruct)  ;; for safety reasons
571                 'corrupted))
572               ((match-end 1)
573                ;; Label
574                (assoc (reftex-match-string 1)
575                       (symbol-value reftex-docstruct-symbol)))
576               ((match-end 3)
577                ;; Section
578                (goto-char (1- (match-beginning 3)))
579                (let* ((list (member (list 'bof (buffer-file-name))
580                                     docstruct))
581                       (endelt (car (member (list 'eof (buffer-file-name))
582                                            list)))
583                       rtn1)
584                  (while (and list (not (eq endelt (car list))))
585                    (if (and (eq (car (car list)) 'toc)
586                             (string= (buffer-file-name)
587                                      (nth 3 (car list))))
588                        (cond
589                         ((equal (point)
590                                 (or (and (markerp (nth 4 (car list)))
591                                          (marker-position (nth 4 (car list))))
592                                     (nth 8 (car list))))
593                          ;; Fits with marker position or recorded position
594                          (setq rtn1 (car list) list nil))
595                         ((looking-at (reftex-make-regexp-allow-for-ctrl-m
596                                       (nth 7 (car list))))
597                          ;; Same title: remember, but keep looking
598                          (setq rtn-if-no-other (car list)))))
599                    (pop list))
600                  rtn1))
601               ((match-end 7)
602                ;; Input or include...
603                (car
604                 (member (list 'eof (reftex-locate-file
605                                     (reftex-match-string 7) "tex"
606                                     (cdr (assq 'master-dir docstruct))))
607                         docstruct)))
608               ((match-end 9)
609                (assq 'appendix (symbol-value reftex-docstruct-symbol)))
610               ((match-end 10)
611                ;; Index entry
612                (when reftex-support-index
613                  (let* ((index-info (save-excursion
614                                       (reftex-index-info-safe nil)))
615                         (list (member (list 'bof (buffer-file-name))
616                                       docstruct))
617                         (endelt (car (member (list 'eof (buffer-file-name))
618                                              list)))
619                         dist last-dist last (n 0))
620                    ;; Check all index entries with equal text
621                    (while (and list (not (eq endelt (car list))))
622                      (when (and (eq (car (car list)) 'index)
623                                 (string= (nth 2 index-info)
624                                          (nth 2 (car list))))
625                        (incf n)
626                        (setq dist (abs (- (point) (nth 4 (car list)))))
627                        (if (or (not last-dist) (< dist last-dist))
628                            (setq last-dist dist last (car list))))
629                      (setq list (cdr list)))
630                    ;; We are sure if we have only one, or a zero distance
631                    (cond ((or (= n 1) (equal dist 0)) last)
632                          ((> n 1) (setq cnt 2) last)
633                          (t nil)))))
634               ((match-end 11)
635                (save-excursion
636                  (goto-char (match-end 11))
637                  (assoc (reftex-no-props
638                          (reftex-nth-arg-wrapper
639                           (reftex-match-string 11)))
640                         (symbol-value reftex-docstruct-symbol))))
641               (t
642                (error "This should not happen (reftex-where-am-I)"))))))
643    ;; Check if there was only a by-name match for the section.
644    (when (and (not rtn) rtn-if-no-other)
645      (setq rtn rtn-if-no-other
646            cnt 2))
647    (cons rtn (eq cnt 1))))
648
649(defun reftex-notice-new (&optional n force)
650  "Hook to handshake with RefTeX after something new has been inserted."
651  ;; Add a new entry to the docstruct list.  If it is a section, renumber
652  ;; the following sections.
653  ;; FIXME:  Put in a WHAT parameter and search backward until one is found.
654  ;; When N is given, go back that many matches of reftex-everything-regexp
655  ;; When FORCE is non-nil, also insert if `reftex-where-am-I' was uncertain.
656  (condition-case nil
657      (catch 'exit
658        (unless reftex-mode (throw 'exit nil))
659        (reftex-access-scan-info)
660        (let* ((docstruct (symbol-value reftex-docstruct-symbol))
661               here-I-am appendix tail entry star level
662               section-number context)
663
664     (save-excursion
665       (when (re-search-backward (reftex-everything-regexp) nil t (or n 1))
666
667         ;; Find where we are
668         (setq here-I-am (reftex-where-am-I))
669         (or here-I-am (throw 'exit nil))
670         (unless (or force (cdr here-I-am)) (throw 'exit nil))
671         (setq tail (memq (car here-I-am) docstruct))
672         (or tail (throw 'exit nil))
673         (setq reftex-active-toc (reftex-last-assoc-before-elt
674                                  'toc (car here-I-am) docstruct)
675               appendix (reftex-last-assoc-before-elt
676                         'appendix (car here-I-am) docstruct))
677
678         ;; Initialize section numbers
679         (if (eq (car (car here-I-am)) 'appendix)
680             (reftex-init-section-numbers nil t)
681           (reftex-init-section-numbers reftex-active-toc appendix))
682
683         ;; Match the section command
684         (when (re-search-forward (reftex-everything-regexp) nil t)
685           (cond
686            ((match-end 1)
687             (push (reftex-label-info (reftex-match-string 1) buffer-file-name)
688                   (cdr tail)))
689
690            ((match-end 3)
691             (setq star (= ?* (char-after (match-end 3)))
692                   entry (reftex-section-info (buffer-file-name))
693                   level (nth 5 entry))
694             ;; Insert the section info
695             (push entry (cdr tail))
696
697             ;; We are done unless we use section numbers
698             (unless (nth 1 reftex-label-menu-flags) (throw 'exit nil))
699
700             ;; Update the remaining toc items
701             (setq tail (cdr tail))
702             (while (and (setq tail (memq (assq 'toc (cdr tail)) tail))
703                         (setq entry (car tail))
704                         (>= (nth 5 entry) level))
705               (setq star (string-match "\\*" (nth 6 entry))
706                     context (nth 2 entry)
707                     section-number
708                     (reftex-section-number (nth 5 entry) star))
709               (when (string-match "\\`\\([ \t]*\\)\\([.0-9A-Z]+\\)\\(.*\\)"
710                                   context)
711                 (when (and (not appendix)
712                            (>= (string-to-char (match-string 2)) ?A))
713                   ;; Just entered the appendex.  Get out.
714                   (throw 'exit nil))
715
716                 ;; Change the section number.
717                 (setf (nth 2 entry)
718                       (concat (match-string 1 context)
719                               section-number
720                               (match-string 3 context))))))
721            ((match-end 10)
722             ;; Index entry
723             (and reftex-support-index
724                  (setq entry (reftex-index-info-safe buffer-file-name))
725                  ;; FIXME: (add-to-list 'index-tags (nth 1 index-entry))
726                  (push entry (cdr tail))))))))))
727
728    (error nil))
729  )
730
731(defsubst reftex-move-to-previous-arg (&optional bound)
732  ;; Assuming that we are in front of a macro argument,
733  ;; move backward to the closing parenthesis of the previous argument.
734  ;; This function understands the splitting of macros over several lines
735  ;; in TeX.
736  (cond
737   ;; Just to be quick:
738   ((memq (preceding-char) '(?\] ?\})))
739   ;; Do a search
740   ((and reftex-allow-detached-macro-args
741         (re-search-backward
742          "[]}][ \t]*[\n\r]?\\([ \t]*%[^\n\r]*[\n\r]\\)*[ \t]*\\=" bound t))
743    (goto-char (1+ (match-beginning 0)))
744    t)
745   (t nil)))
746
747(defun reftex-what-macro-safe (which &optional bound)
748  ;; reftex-what-macro with special syntax table.
749  (reftex-with-special-syntax
750   (reftex-what-macro which bound)))
751
752(defun reftex-what-macro (which &optional bound)
753  ;; Find out if point is within the arguments of any TeX-macro.
754  ;; The return value is either ("\\macro" . (point)) or a list of them.
755
756  ;; If WHICH is nil, immediately return nil.
757  ;; If WHICH is 1, return innermost enclosing macro.
758  ;; If WHICH is t, return list of all macros enclosing point.
759  ;; If WHICH is a list of macros, look only for those macros and return the
760  ;;    name of the first macro in this list found to enclose point.
761  ;; If the optional BOUND is an integer, bound backwards directed
762  ;;    searches to this point.  If it is nil, limit to nearest \section -
763  ;;    like statement.
764
765  ;; This function is pretty stable, but can be fooled if the text contains
766  ;; things like \macro{aa}{bb} where \macro is defined to take only one
767  ;; argument.  As RefTeX cannot know this, the string "bb" would still be
768  ;; considered an argument of macro \macro.
769
770  (unless reftex-section-regexp (reftex-compile-variables))
771  (catch 'exit
772    (if (null which) (throw 'exit nil))
773    (let ((bound (or bound (save-excursion (re-search-backward
774                                            reftex-section-regexp nil 1)
775                                           (point))))
776          pos cmd-list cmd cnt cnt-opt entry)
777      (save-restriction
778        (save-excursion
779          (narrow-to-region (max 1 bound) (point-max))
780          ;; move back out of the current parenthesis
781          (while (condition-case nil
782                     (progn (up-list -1) t)
783                   (error nil))
784            (setq cnt 1 cnt-opt 0)
785            ;; move back over any touching sexps
786            (while (and (reftex-move-to-previous-arg bound)
787                        (condition-case nil
788                            (progn (backward-sexp) t)
789                          (error nil)))
790              (if (eq (following-char) ?\[) (incf cnt-opt))
791              (incf cnt))
792            (setq pos (point))
793            (when (and (or (= (following-char) ?\[)
794                           (= (following-char) ?\{))
795                       (re-search-backward "\\\\[*a-zA-Z]+\\=" nil t))
796              (setq cmd (reftex-match-string 0))
797              (when (looking-at "\\\\begin{[^}]*}")
798                (setq cmd (reftex-match-string 0)
799                      cnt (1- cnt)))
800              ;; This does ignore optional arguments.  Very hard to fix.
801              (when (setq entry (assoc cmd reftex-env-or-mac-alist))
802                (if (> cnt (or (nth 4 entry) 100))
803                    (setq cmd nil)))
804              (cond
805               ((null cmd))
806               ((eq t which)
807                (push (cons cmd (point)) cmd-list))
808               ((or (eq 1 which) (member cmd which))
809                (throw 'exit (cons cmd (point))))))
810            (goto-char pos)))
811        (nreverse cmd-list)))))
812
813(defun reftex-what-environment (which &optional bound)
814  ;; Find out if point is inside a LaTeX environment.
815  ;; The return value is (e.g.) either ("equation" . (point)) or a list of
816  ;; them.
817
818  ;; If WHICH is nil, immediately return nil.
819  ;; If WHICH is 1, return innermost enclosing environment.
820  ;; If WHICH is t, return list of all environments enclosing point.
821  ;; If WHICH is a list of environments, look only for those environments and
822  ;;   return the name of the first environment in this list found to enclose
823  ;;   point.
824
825  ;; If the optional BOUND is an integer, bound backwards directed searches to
826  ;; this point.  If it is nil, limit to nearest \section - like statement.
827
828  (unless reftex-section-regexp (reftex-compile-variables))
829  (catch 'exit
830    (save-excursion
831      (if (null which) (throw 'exit nil))
832      (let ((bound (or bound (save-excursion (re-search-backward
833                                              reftex-section-regexp nil 1)
834                                             (point))))
835            env-list end-list env)
836        (while (re-search-backward "\\\\\\(begin\\|end\\){\\([^}]+\\)}"
837                                   bound t)
838          (setq env (buffer-substring-no-properties
839                     (match-beginning 2) (match-end 2)))
840          (cond
841           ((string= (match-string 1) "end")
842            (push env end-list))
843           ((equal env (car end-list))
844            (setq end-list (cdr end-list)))
845           ((eq t which)
846            (push (cons env (point)) env-list))
847           ((or (eq 1 which) (member env which))
848            (throw 'exit (cons env (point))))))
849        (nreverse env-list)))))
850
851(defun reftex-what-special-env (which &optional bound)
852  ;; Run the special environment parsers and return the matches.
853  ;;
854  ;; The return value is (e.g.) either ("my-parser-function" . (point))
855  ;; or a list of them.
856
857  ;; If WHICH is nil, immediately return nil.
858  ;; If WHICH is 1, return innermost enclosing environment.
859  ;; If WHICH is t, return list of all environments enclosing point.
860  ;; If WHICH is a list of environments, look only for those environments and
861  ;;   return the name of the first environment in this list found to enclose
862  ;;   point.
863
864  (unless reftex-section-regexp (reftex-compile-variables))
865  (catch 'exit
866    (save-excursion
867      (if (null reftex-special-env-parsers) (throw 'exit nil))
868      (if (null which) (throw 'exit nil))
869      (let ((bound (or bound (save-excursion (re-search-backward
870                                              reftex-section-regexp nil 1)
871                                             (point))))
872            (fun-list (if (listp which)
873                          (mapcar (lambda (x) (if (memq x which) x nil))
874                                  reftex-special-env-parsers)
875                        reftex-special-env-parsers))
876            specials rtn)
877        ;; Call all functions
878        (setq specials (mapcar
879                        (lambda (fun)
880                          (save-excursion
881                            (setq rtn (and fun (funcall fun bound)))
882                            (if rtn (cons (symbol-name fun) rtn) nil)))
883                        fun-list))
884        ;; Delete the non-matches
885        (setq specials (delq nil specials))
886        ;; Sort
887        (setq specials (sort specials (lambda (a b) (> (cdr a) (cdr b)))))
888        (if (eq which t)
889            specials
890          (car specials))))))
891
892(defsubst reftex-move-to-next-arg (&optional ignore)
893  ;; Assuming that we are at the end of a macro name or a macro argument,
894  ;; move forward to the opening parenthesis of the next argument.
895  ;; This function understands the splitting of macros over several lines
896  ;; in TeX.
897  (cond
898   ;; Just to be quick:
899   ((memq (following-char) '(?\[ ?\{)))
900   ;; Do a search
901   ((and reftex-allow-detached-macro-args
902         (looking-at "[ \t]*[\n\r]?\\([ \t]*%[^\n\r]*[\n\r]\\)*[ \t]*[[{]"))
903    (goto-char (1- (match-end 0)))
904    t)
905   (t nil)))
906
907(defun reftex-nth-arg-wrapper (key)
908  (let ((entry (assoc key reftex-env-or-mac-alist)))
909    (reftex-nth-arg (nth 5 entry) (nth 6 entry))))
910
911(defun reftex-nth-arg (n &optional opt-args)
912  ;; Return the nth following {} or [] parentheses content.
913  ;; OPT-ARGS is a list of argument numbers which are optional.
914
915  ;; If we are sitting at a macro start, skip to end of macro name.
916  (and (eq (following-char) ?\\) (skip-chars-forward "a-zA-Z*\\\\"))
917
918  (if (= n 1000)
919      ;; Special case:  Skip all touching arguments
920      (progn
921        (reftex-move-over-touching-args)
922        (reftex-context-substring))
923
924    ;; Do the real thing.
925    (let ((cnt 1))
926
927      (when (reftex-move-to-next-arg)
928
929        (while (< cnt n)
930          (while (and (member cnt opt-args)
931                      (eq (following-char) ?\{))
932            (incf cnt))
933          (when (< cnt n)
934            (unless (and (condition-case nil
935                             (or (forward-list 1) t)
936                           (error nil))
937                         (reftex-move-to-next-arg)
938                         (incf cnt))
939              (setq cnt 1000))))
940
941        (while (and (memq cnt opt-args)
942                    (eq (following-char) ?\{))
943          (incf cnt)))
944      (if (and (= n cnt)
945               (> (skip-chars-forward "{\\[") 0))
946          (reftex-context-substring)
947        nil))))
948
949(defun reftex-move-over-touching-args ()
950  (condition-case nil
951      (while (memq (following-char) '(?\[ ?\{))
952        (forward-list 1))
953    (error nil)))
954
955(defun reftex-context-substring (&optional to-end)
956  ;; Return up to 150 chars from point
957  ;; When point is just after a { or [, limit string to matching parenthesis
958  (cond
959   (to-end
960    ;; Environment - find next \end
961    (buffer-substring-no-properties
962     (point)
963     (min (+ (point) 150)
964          (save-match-data
965            ;; FIXME: This is not perfect
966            (if (re-search-forward "\\\\end{" nil t)
967                (match-beginning 0)
968              (point-max))))))
969   ((or (= (preceding-char) ?\{)
970        (= (preceding-char) ?\[))
971    ;; Inside a list - get only the list.
972    (buffer-substring-no-properties
973     (point)
974     (min (+ (point) 150)
975          (point-max)
976          (condition-case nil
977              (progn
978                (up-list 1)
979                (1- (point)))
980            (error (point-max))))))
981   (t
982    ;; no list - just grab 150 characters
983    (buffer-substring-no-properties (point)
984                                    (min (+ (point) 150) (point-max))))))
985
986;; Variable holding the vector with section numbers
987(defvar reftex-section-numbers (make-vector reftex-max-section-depth 0))
988
989(defun reftex-init-section-numbers (&optional toc-entry appendix)
990  ;; Initialize the section numbers with zeros or with what is found
991  ;; in the toc entry.
992  (let* ((level  (or (nth 5 toc-entry) -1))
993         (numbers (nreverse (split-string (or (nth 6 toc-entry) "") "\\.")))
994         (depth (1- (length reftex-section-numbers)))
995         (i depth) number-string)
996    (while (>= i 0)
997      (if (> i level)
998          (aset reftex-section-numbers i 0)
999        (setq number-string (or (car numbers) "0"))
1000        (if (string-match "\\`[A-Z]\\'" number-string)
1001            (aset reftex-section-numbers i
1002                  (- (string-to-char number-string) ?A -1))
1003            (aset reftex-section-numbers i (string-to-number number-string)))
1004        (pop numbers))
1005      (decf i)))
1006  (put 'reftex-section-numbers 'appendix appendix))
1007
1008(defun reftex-section-number (&optional level star)
1009  ;; Return a string with the current section number.
1010  ;; When LEVEL is non-nil, increase section numbers on that level.
1011  (let* ((depth (1- (length reftex-section-numbers))) idx n (string "")
1012         (appendix (get 'reftex-section-numbers 'appendix))
1013         (partspecial (and (not reftex-part-resets-chapter)
1014                           (equal level 0))))
1015    ;; partspecial means, this is a part statement.
1016    ;; Parts do not reset the chapter counter, and the part number is
1017    ;; not included in the numbering of other sectioning levels.
1018    (when level
1019      (when (and (> level -1) (not star))
1020        (aset reftex-section-numbers
1021              level (1+ (aref reftex-section-numbers level))))
1022      (setq idx (1+ level))
1023      (when (not star)
1024        (while (<= idx depth)
1025          (if (or (not partspecial)
1026                  (not (= idx 1)))
1027              (aset reftex-section-numbers idx 0))
1028          (incf idx))))
1029    (if partspecial
1030        (setq string (concat "Part " (reftex-roman-number
1031                                      (aref reftex-section-numbers 0))))
1032      (setq idx (if reftex-part-resets-chapter 0 1))
1033      (while (<= idx depth)
1034        (setq n (aref reftex-section-numbers idx))
1035        (if (not (and partspecial (not (equal string ""))))
1036            (setq string (concat string (if (not (string= string "")) "." "")
1037                                 (int-to-string n))))
1038        (incf idx))
1039      (save-match-data
1040        (if (string-match "\\`\\([@0]\\.\\)+" string)
1041            (setq string (replace-match "" nil nil string)))
1042        (if (string-match "\\(\\.0\\)+\\'" string)
1043            (setq string (replace-match "" nil nil string)))
1044        (if (and appendix
1045                 (string-match "\\`[0-9]+" string))
1046            (setq string
1047                  (concat
1048                   (char-to-string
1049                    (1- (+ ?A (string-to-number (match-string 0 string)))))
1050                   (substring string (match-end 0))))))
1051      (if star
1052          (concat (make-string (1- (length string)) ?\ ) "*")
1053        string))))
1054
1055(defun reftex-roman-number (n)
1056  ;; Return as a string the roman number equal to N.
1057  (let ((nrest n)
1058        (string "")
1059        (list '((1000 . "M") ( 900 . "CM") ( 500 . "D") ( 400 . "CD")
1060                ( 100 . "C") (  90 . "XC") (  50 . "L") (  40 . "XL")
1061                (  10 . "X") (   9 . "IX") (   5 . "V") (   4 . "IV")
1062                (   1 . "I")))
1063        listel i s)
1064    (while (>= nrest 1)
1065      (setq listel (pop list)
1066            i (car listel)
1067            s (cdr listel))
1068      (while (>= nrest i)
1069        (setq string (concat string s)
1070              nrest (- nrest i))))
1071    string))
1072
1073;;; arch-tag: 6a8168f7-abb9-4576-99dc-fcbc7ba901a3
1074;;; reftex-parse.el ends here
1075