/[emacs]/emacs/lisp/textmodes/reftex-ref.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/reftex-ref.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10.8.1 by miles, Fri Apr 4 06:20:40 2003 UTC revision 1.10.8.2 by miles, Tue Oct 14 23:30:22 2003 UTC
# Line 1  Line 1 
1  ;;; reftex-ref.el --- code to create labels and references with RefTeX  ;;; reftex-ref.el --- code to create labels and references with RefTeX
2  ;; Copyright (c) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.  ;; Copyright (c) 1997, 1998, 1999, 2000, 2003 Free Software Foundation, Inc.
3    
4  ;; Author: Carsten Dominik <dominik@science.uva.nl>  ;; Author: Carsten Dominik <dominik@science.uva.nl>
5  ;; Version: 4.18  ;; Version: 4.21
6    
7  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
8    
# Line 36  If optional BOUND is an integer, limit b Line 36  If optional BOUND is an integer, limit b
36    
37    (let* ((loc1 (reftex-what-macro reftex-label-mac-list bound))    (let* ((loc1 (reftex-what-macro reftex-label-mac-list bound))
38           (loc2 (reftex-what-environment reftex-label-env-list bound))           (loc2 (reftex-what-environment reftex-label-env-list bound))
39           (loc3 (reftex-what-special-env 1 bound))           (loc3 (reftex-what-special-env 1 bound))
40           (p1 (or (cdr loc1) 0))           (p1 (or (cdr loc1) 0))
41           (p2 (or (cdr loc2) 0))           (p2 (or (cdr loc2) 0))
42           (p3 (or (cdr loc3) 0))           (p3 (or (cdr loc3) 0))
43           (pmax (max p1 p2 p3)))           (pmax (max p1 p2 p3)))
44    
45      (setq reftex-location-start pmax)      (setq reftex-location-start pmax)
46      (cond      (cond
# Line 57  If optional BOUND is an integer, limit b Line 57  If optional BOUND is an integer, limit b
57        (setq reftex-default-context-position p3)        (setq reftex-default-context-position p3)
58        (setq loc3 (car loc3))        (setq loc3 (car loc3))
59        (cond ((null loc3) "section")        (cond ((null loc3) "section")
60              ((symbolp loc3) (symbol-name loc3))              ((symbolp loc3) (symbol-name loc3))
61              ((stringp loc3) loc3)              ((stringp loc3) loc3)
62              (t "section")))              (t "section")))
63       (t ;; This should not happen, I think?       (t ;; This should not happen, I think?
64        "section"))))        "section"))))
65    
# Line 83  If optional BOUND is an integer, limit b Line 83  If optional BOUND is an integer, limit b
83            (goto-char 1)            (goto-char 1)
84    
85            (if (or (re-search-forward            (if (or (re-search-forward
86                     (format reftex-find-label-regexp-format                     (format reftex-find-label-regexp-format
87                             (regexp-quote label)) nil t)                             (regexp-quote label)) nil t)
88                    (re-search-forward                    (re-search-forward
89                     (format reftex-find-label-regexp-format2                     (format reftex-find-label-regexp-format2
90                             (regexp-quote label)) nil t))                             (regexp-quote label)) nil t))
91    
92                (progn                (progn
93                  (backward-char 1)                  (backward-char 1)
# Line 102  If optional BOUND is an integer, limit b Line 102  If optional BOUND is an integer, limit b
102           (parse (nth 2 (assoc env-or-mac reftex-env-or-mac-alist)))           (parse (nth 2 (assoc env-or-mac reftex-env-or-mac-alist)))
103           (text (reftex-short-context env-or-mac parse reftex-location-start           (text (reftex-short-context env-or-mac parse reftex-location-start
104                                       derive))                                       derive))
105           (in-comment (reftex-in-comment)))           (in-comment (reftex-in-comment)))
106      (list label typekey text file in-comment)))      (list label typekey text file in-comment)))
107    
108  ;;; Creating labels ---------------------------------------------------------  ;;; Creating labels ---------------------------------------------------------
# Line 132  This function is controlled by the setti Line 132  This function is controlled by the setti
132    ;; Ok, go ahead.    ;; Ok, go ahead.
133    (catch 'exit    (catch 'exit
134      (let* ((entry (assoc environment reftex-env-or-mac-alist))      (let* ((entry (assoc environment reftex-env-or-mac-alist))
135             (typekey (nth 1 entry))             (typekey (nth 1 entry))
136             (format (nth 3 entry))             (format (nth 3 entry))
137             (macro-cell (reftex-what-macro 1))             (macro-cell (reftex-what-macro 1))
138             (entry1 (assoc (car macro-cell) reftex-env-or-mac-alist))             (entry1 (assoc (car macro-cell) reftex-env-or-mac-alist))
139             label naked prefix valid default force-prompt rescan-is-useful)             label naked prefix valid default force-prompt rescan-is-useful)
140        (when (and (or (nth 5 entry) (nth 5 entry1))        (when (and (or (nth 5 entry) (nth 5 entry1))
141                   (memq (preceding-char) '(?\[ ?\{)))                   (memq (preceding-char) '(?\[ ?\{)))
142          ;; This is an argument of a label macro.  Insert naked label.          ;; This is an argument of a label macro.  Insert naked label.
143          (setq naked t format "%s"))          (setq naked t format "%s"))
144    
145        (setq prefix (or (cdr (assoc typekey reftex-typekey-to-prefix-alist))        (setq prefix (or (cdr (assoc typekey reftex-typekey-to-prefix-alist))
146                         (concat typekey "-")))                         (concat typekey "-")))
147        ;; Replace any escapes in the prefix        ;; Replace any escapes in the prefix
148        (setq prefix (reftex-replace-prefix-escapes prefix))        (setq prefix (reftex-replace-prefix-escapes prefix))
149    
# Line 151  This function is controlled by the setti Line 151  This function is controlled by the setti
151        (cond        (cond
152    
153         ((reftex-typekey-check typekey (nth 0 reftex-insert-label-flags))         ((reftex-typekey-check typekey (nth 0 reftex-insert-label-flags))
154          ;; Derive a label from context.          ;; Derive a label from context.
155          (setq reftex-active-toc (reftex-last-assoc-before-elt          (setq reftex-active-toc (reftex-last-assoc-before-elt
156                                   'toc (car (reftex-where-am-I))                                   'toc (car (reftex-where-am-I))
157                                   (symbol-value reftex-docstruct-symbol)))                                   (symbol-value reftex-docstruct-symbol)))
158          (setq default (reftex-no-props          (setq default (reftex-no-props
159                         (nth 2 (reftex-label-info " " nil nil t))))                         (nth 2 (reftex-label-info " " nil nil t))))
160          ;; Catch the cases where the is actually no context available.          ;; Catch the cases where the is actually no context available.
161          (if (or (string-match "NO MATCH FOR CONTEXT REGEXP" default)          (if (or (string-match "NO MATCH FOR CONTEXT REGEXP" default)
162                  (string-match "ILLEGAL VALUE OF PARSE" default)                  (string-match "ILLEGAL VALUE OF PARSE" default)
163                  (string-match "SECTION HEADING NOT FOUND" default)                  (string-match "SECTION HEADING NOT FOUND" default)
164                  (string-match "HOOK ERROR" default)                  (string-match "HOOK ERROR" default)
165                  (string-match "^[ \t]*$" default))                  (string-match "^[ \t]*$" default))
166              (setq default prefix              (setq default prefix
167                    force-prompt t)       ; need to prompt                    force-prompt t)       ; need to prompt
168            (setq default            (setq default
169                  (concat prefix                  (concat prefix
170                          (funcall reftex-string-to-label-function default)))                          (funcall reftex-string-to-label-function default)))
171    
172            ;; Make it unique.            ;; Make it unique.
173            (setq default (reftex-uniquify-label default nil "-"))))            (setq default (reftex-uniquify-label default nil "-"))))
174    
175         ((reftex-typekey-check typekey (nth 1 reftex-insert-label-flags))         ((reftex-typekey-check typekey (nth 1 reftex-insert-label-flags))
176          ;; Minimal default: the user will be prompted.          ;; Minimal default: the user will be prompted.
177          (setq default prefix))          (setq default prefix))
178    
179         (t         (t
180          ;; Make an automatic label.          ;; Make an automatic label.
181          (setq default (reftex-uniquify-label prefix t))))          (setq default (reftex-uniquify-label prefix t))))
182    
183        ;; Should we ask the user?        ;; Should we ask the user?
184        (if (or (reftex-typekey-check typekey        (if (or (reftex-typekey-check typekey
185                                      (nth 1 reftex-insert-label-flags)) ; prompt                                      (nth 1 reftex-insert-label-flags)) ; prompt
186                force-prompt)                force-prompt)
187    
188            (while (not valid)            (while (not valid)
189              ;; iterate until we get a legal label              ;; iterate until we get a legal label
190    
191              (setq label (read-string              (setq label (read-string
192                           (if naked "Naked Label: " "Label: ")                           (if naked "Naked Label: " "Label: ")
193                           default))                           default))
194    
195              ;; Lets make sure that this is a legal label              ;; Lets make sure that this is a legal label
196              (cond              (cond
197    
198               ((string-match (concat "\\`\\(" (regexp-quote prefix)               ((string-match (concat "\\`\\(" (regexp-quote prefix)
199                                      "\\)?[ \t]*\\'")                                      "\\)?[ \t]*\\'")
200                              label)                              label)
201                ;; No label at all, please                ;; No label at all, please
202                (message "No label inserted.")                (message "No label inserted.")
203                (throw 'exit nil))                (throw 'exit nil))
204    
205               ;; Test if label contains strange characters               ;; Test if label contains strange characters
206               ((string-match reftex-label-illegal-re label)               ((string-match reftex-label-illegal-re label)
207                (message "Label \"%s\" contains illegal characters" label)                (message "Label \"%s\" contains illegal characters" label)
208                (ding)                (ding)
209                (sit-for 2))                (sit-for 2))
210    
211               ;; Look it up in the label list               ;; Look it up in the label list
212               ((setq entry (assoc label               ((setq entry (assoc label
213                                   (symbol-value reftex-docstruct-symbol)))                                   (symbol-value reftex-docstruct-symbol)))
214                (ding)                (ding)
215                (if (y-or-n-p                (if (y-or-n-p
216                     (format "Label '%s' exists. Use anyway? " label))                     (format "Label '%s' exists. Use anyway? " label))
217                    (setq valid t)))                    (setq valid t)))
218    
219               ;; Label is ok               ;; Label is ok
220               (t               (t
221                (setq valid t))))                (setq valid t))))
222          (setq label default))          (setq label default))
223    
224        ;; Insert the label into the label list        ;; Insert the label into the label list
225        (let* ((here-I-am-info        (let* ((here-I-am-info
226                (save-excursion                (save-excursion
227                  (if (and (or naked no-insert)                  (if (and (or naked no-insert)
228                           (integerp (cdr macro-cell)))                           (integerp (cdr macro-cell)))
229                      (goto-char (cdr macro-cell)))                      (goto-char (cdr macro-cell)))
230                  (reftex-where-am-I)))                  (reftex-where-am-I)))
231               (here-I-am (car here-I-am-info))               (here-I-am (car here-I-am-info))
232               (note (if (cdr here-I-am-info)               (note (if (cdr here-I-am-info)
233                         ""                         ""
234                       "POSITION UNCERTAIN.  RESCAN TO FIX."))                       "POSITION UNCERTAIN.  RESCAN TO FIX."))
235               (file (buffer-file-name))               (file (buffer-file-name))
236               (text nil)               (text nil)
237               (tail (memq here-I-am (symbol-value reftex-docstruct-symbol))))               (tail (memq here-I-am (symbol-value reftex-docstruct-symbol))))
238    
239          (or (cdr here-I-am-info) (setq rescan-is-useful t))          (or (cdr here-I-am-info) (setq rescan-is-useful t))
240    
241          (when tail          (when tail
242            (push (list label typekey text file nil note) (cdr tail))            (push (list label typekey text file nil note) (cdr tail))
243            (put reftex-docstruct-symbol 'modified t)))            (put reftex-docstruct-symbol 'modified t)))
244    
245        ;; Insert the label into the buffer        ;; Insert the label into the buffer
246        (unless no-insert        (unless no-insert
247          (insert          (insert
248           (if reftex-format-label-function           (if reftex-format-label-function
249               (funcall reftex-format-label-function label format)               (funcall reftex-format-label-function label format)
250             (format format label)))             (format format label)))
251          (if (and reftex-plug-into-AUCTeX          (if (and reftex-plug-into-AUCTeX
252                   (fboundp 'LaTeX-add-labels))                   (fboundp 'LaTeX-add-labels))
253              ;; Tell AUCTeX about this              ;; Tell AUCTeX about this
254              (LaTeX-add-labels label)))              (LaTeX-add-labels label)))
255    
256        ;; Delete the corresponding selection buffers to force update on next use.        ;; Delete the corresponding selection buffers to force update on next use.
257        (when reftex-auto-update-selection-buffers        (when reftex-auto-update-selection-buffers
258          (reftex-erase-buffer (reftex-make-selection-buffer-name typekey))          (reftex-erase-buffer (reftex-make-selection-buffer-name typekey))
259          (reftex-erase-buffer (reftex-make-selection-buffer-name " ")))          (reftex-erase-buffer (reftex-make-selection-buffer-name " ")))
260    
261        (when (and rescan-is-useful reftex-allow-automatic-rescan)        (when (and rescan-is-useful reftex-allow-automatic-rescan)
262          (reftex-parse-one))          (reftex-parse-one))
263    
264        ;; return value of the function is the label        ;; return value of the function is the label
265        label)))        label)))
# Line 269  This function is controlled by the setti Line 269  This function is controlled by the setti
269  Uses `reftex-derive-label-parameters' and `reftex-label-illegal-re'.  It  Uses `reftex-derive-label-parameters' and `reftex-label-illegal-re'.  It
270  also applies `reftex-translate-to-ascii-function' to the string."  also applies `reftex-translate-to-ascii-function' to the string."
271    (when (and reftex-translate-to-ascii-function    (when (and reftex-translate-to-ascii-function
272               (fboundp reftex-translate-to-ascii-function))               (fboundp reftex-translate-to-ascii-function))
273      (setq string (funcall reftex-translate-to-ascii-function string)))      (setq string (funcall reftex-translate-to-ascii-function string)))
274    (apply 'reftex-convert-string string    (apply 'reftex-convert-string string
275           "[-~ \t\n\r,;]+" reftex-label-illegal-re nil nil           "[-~ \t\n\r,;]+" reftex-label-illegal-re nil nil
276           reftex-derive-label-parameters))           reftex-derive-label-parameters))
277    
278  (defun reftex-latin1-to-ascii (string)  (defun reftex-latin1-to-ascii (string)
279    ;; Translate the upper 128 chars in the Latin-1 charset to ASCII equivalents    ;; Translate the upper 128 chars in the Latin-1 charset to ASCII equivalents
280    (let ((tab "@@@@@@@@@@@@@@@@@@'@@@@@@@@@@@@@ icLxY|S\"ca<--R-o|23'uq..1o>423?AAAAAAACEEEEIIIIDNOOOOOXOUUUUYP3aaaaaaaceeeeiiiidnooooo:ouuuuypy")    (let ((tab "@@@@@@@@@@@@@@@@@@'@@@@@@@@@@@@@ icLxY|S\"ca<--R-o|23'uq..1o>423?AAAAAAACEEEEIIIIDNOOOOOXOUUUUYP3aaaaaaaceeeeiiiidnooooo:ouuuuypy")
281          (emacsp (not (featurep 'xemacs))))          (emacsp (not (featurep 'xemacs))))
282      (mapconcat      (mapconcat
283       (lambda (c)       (lambda (c)
284         (cond ((and (> c 127) (< c 256))                 ; 8 bit Latin-1         (cond ((and (> c 127) (< c 256))                 ; 8 bit Latin-1
285                (char-to-string (aref tab (- c 128))))                (char-to-string (aref tab (- c 128))))
286               ((and emacsp                               ; Not for XEmacs               ((and emacsp                               ; Not for XEmacs
287                     (> c 2175) (< c 2304))               ; Mule Latin-1                     (> c 2175) (< c 2304))               ; Mule Latin-1
288                (char-to-string (aref tab (- c 2176))))                (char-to-string (aref tab (- c 2176))))
289               (t (char-to-string c))))               (t (char-to-string c))))
290       string "")))       string "")))
291    
292  (defun reftex-replace-prefix-escapes (prefix)  (defun reftex-replace-prefix-escapes (prefix)
# Line 309  also applies `reftex-translate-to-ascii- Line 309  also applies `reftex-translate-to-ascii-
309                      file)))                      file)))
310                 ((equal letter "u")                 ((equal letter "u")
311                  (or (user-login-name) ""))                  (or (user-login-name) ""))
312                 ((equal letter "S")                 ((equal letter "S")
313                  (let* (macro level-exp level)                  (let* (macro level-exp level)
314                    (save-excursion                    (save-excursion
315                      (save-match-data                      (save-match-data
316                        (when (re-search-backward reftex-section-regexp nil t)                        (when (re-search-backward reftex-section-regexp nil t)
317                          (setq macro (reftex-match-string 2)                          (setq macro (reftex-match-string 2)
318                                level-exp (cdr (assoc macro reftex-section-levels-all))                                level-exp (cdr (assoc macro reftex-section-levels-all))
319                                level (if (symbolp level-exp)                                level (if (symbolp level-exp)
320                                          (abs (save-match-data                                          (abs (save-match-data
321                                                 (funcall level-exp)))                                                 (funcall level-exp)))
322                                        (abs level-exp))))                                        (abs level-exp))))
323                        (cdr (or (assoc macro reftex-section-prefixes)                        (cdr (or (assoc macro reftex-section-prefixes)
324                                 (assoc level reftex-section-prefixes)                                 (assoc level reftex-section-prefixes)
325                                 (assq t reftex-section-prefixes)                                 (assq t reftex-section-prefixes)
326                                 (list t "sec:")))))))                                 (list t "sec:")))))))
327                 (t "")))                 (t "")))
328          (setq num (1- (+ (match-beginning 1) (length replace)))          (setq num (1- (+ (match-beginning 1) (length replace)))
329                prefix (replace-match replace nil nil prefix)))                prefix (replace-match replace nil nil prefix)))
# Line 403  When called with 2 C-u prefix args, disa Line 403  When called with 2 C-u prefix args, disa
403      ;; guess type from context      ;; guess type from context
404      (if (and reftex-guess-label-type      (if (and reftex-guess-label-type
405               (setq type (reftex-guess-label-type)))               (setq type (reftex-guess-label-type)))
406          (setq cut (cdr type)          (setq cut (cdr type)
407                type (car type))                type (car type))
408        (setq type (reftex-query-label-type))))        (setq type (reftex-query-label-type))))
409    
410    (let* ((refstyle    (let* ((refstyle
411            (cond ((reftex-typekey-check type reftex-vref-is-default) "\\vref")            (cond ((reftex-typekey-check type reftex-vref-is-default) "\\vref")
412                  ((reftex-typekey-check type reftex-fref-is-default) "\\fref")                  ((reftex-typekey-check type reftex-fref-is-default) "\\fref")
413                  (t "\\ref")))                  (t "\\ref")))
414           (reftex-format-ref-function reftex-format-ref-function)           (reftex-format-ref-function reftex-format-ref-function)
415           (form "\\ref{%s}")           (form "\\ref{%s}")
416           label labels sep sep1)           label labels sep sep1)
417    
418      ;; Have the user select a label      ;; Have the user select a label
419      (set-marker reftex-select-return-marker (point))      (set-marker reftex-select-return-marker (point))
420      (setq labels (save-excursion      (setq labels (save-excursion
421                     (reftex-offer-label-menu type)))                     (reftex-offer-label-menu type)))
422      (reftex-ensure-compiled-variables)      (reftex-ensure-compiled-variables)
423      (set-marker reftex-select-return-marker nil)      (set-marker reftex-select-return-marker nil)
424      ;; If the first entry is the symbol 'concat, concat all labels.      ;; If the first entry is the symbol 'concat, concat all labels.
425      ;; We keep the cdr of the first label for typekey etc information.      ;; We keep the cdr of the first label for typekey etc information.
426      (if (eq (car labels) 'concat)      (if (eq (car labels) 'concat)
427          (setq labels (list (list (mapconcat 'car (cdr labels) ",")          (setq labels (list (list (mapconcat 'car (cdr labels) ",")
428                                   (cdr (nth 1 labels))))))                                   (cdr (nth 1 labels))))))
429      (setq type (nth 1 (car labels))      (setq type (nth 1 (car labels))
430            form (or (cdr (assoc type reftex-typekey-to-format-alist))            form (or (cdr (assoc type reftex-typekey-to-format-alist))
431                     form))                     form))
432        
433      (cond      (cond
434       (no-insert       (no-insert
435        ;; Just return the first label        ;; Just return the first label
# Line 439  When called with 2 C-u prefix args, disa Line 439  When called with 2 C-u prefix args, disa
439        nil)        nil)
440       (t       (t
441        (while labels        (while labels
442          (setq label (car (car labels))          (setq label (car (car labels))
443                sep (nth 2 (car labels))                sep (nth 2 (car labels))
444                sep1 (cdr (assoc sep reftex-multiref-punctuation))                sep1 (cdr (assoc sep reftex-multiref-punctuation))
445                labels (cdr labels))                labels (cdr labels))
446          (when cut          (when cut
447            (backward-delete-char cut)            (backward-delete-char cut)
448            (setq cut nil))            (setq cut nil))
449    
450          ;; remove ~ if we do already have a space          ;; remove ~ if we do already have a space
451          (when (and (= ?~ (string-to-char form))          (when (and (= ?~ (string-to-char form))
452                     (member (preceding-char) '(?\  ?\t ?\n)))                     (member (preceding-char) '(?\ ?\t ?\n ?. ?~)))
453            (setq form (substring form 1)))            (setq form (substring form 1)))
454          ;; do we have a special format?          ;; do we have a special format?
455          (setq reftex-format-ref-function          (setq reftex-format-ref-function
456                (cond                (cond
457                 ((string= refstyle "\\vref") 'reftex-format-vref)                 ((string= refstyle "\\vref") 'reftex-format-vref)
458                 ((string= refstyle "\\fref") 'reftex-format-fref)                 ((string= refstyle "\\fref") 'reftex-format-fref)
459                 ((string= refstyle "\\Fref") 'reftex-format-Fref)                 ((string= refstyle "\\Fref") 'reftex-format-Fref)
460                 (t reftex-format-ref-function)))                 (t reftex-format-ref-function)))
461          ;; ok, insert the reference          ;; ok, insert the reference
462          (if sep1 (insert sep1))          (if sep1 (insert sep1))
463          (insert          (insert
464           (if reftex-format-ref-function           (if reftex-format-ref-function
465               (funcall reftex-format-ref-function label form)               (funcall reftex-format-ref-function label form)
466             (format form label label)))             (format form label label)))
467          ;; take out the initial ~ for good          ;; take out the initial ~ for good
468          (and (= ?~ (string-to-char form))          (and (= ?~ (string-to-char form))
469               (setq form (substring form 1))))               (setq form (substring form 1))))
470        (message "")        (message "")
471        label))))        label))))
472    
473  (defun reftex-guess-label-type ()  (defun reftex-guess-label-type ()
474    ;; Examine context to guess what a \ref might want to reference.    ;; Examine context to guess what a \ref might want to reference.
475    (let ((words reftex-words-to-typekey-alist)    (let ((words reftex-words-to-typekey-alist)
476          (case-fold-search t)          (case-fold-search t)
477          (bound (max (point-min) (- (point) 35)))          (bound (max (point-min) (- (point) 35)))
478          matched cell)          matched cell)
479      (save-excursion      (save-excursion
480        (while (and (setq cell (pop words))        (while (and (setq cell (pop words))
481                    (not (setq matched                    (not (setq matched
482                               (re-search-backward (car cell) bound t))))))                               (re-search-backward (car cell) bound t))))))
483      (if matched      (if matched
484          (cons (cdr cell) (- (match-end 0) (match-end 1)))          (cons (cdr cell) (- (match-end 0) (match-end 1)))
485        nil)))        nil)))
486    
487  (defvar reftex-select-label-map)  (defvar reftex-select-label-map)
488  (defun reftex-offer-label-menu (typekey)  (defun reftex-offer-label-menu (typekey)
489    ;; Offer a menu with the appropriate labels.    ;; Offer a menu with the appropriate labels.
490    (let* ((buf (current-buffer))    (let* ((buf (current-buffer))
491           (xr-data (assq 'xr (symbol-value reftex-docstruct-symbol)))           (xr-data (assq 'xr (symbol-value reftex-docstruct-symbol)))
492           (xr-alist (cons (cons "" (buffer-file-name)) (nth 1 xr-data)))           (xr-alist (cons (cons "" (buffer-file-name)) (nth 1 xr-data)))
493           (xr-index 0)           (xr-index 0)
494           (here-I-am (car (reftex-where-am-I)))           (here-I-am (car (reftex-where-am-I)))
495           (here-I-am1 here-I-am)           (here-I-am1 here-I-am)
496           (toc (reftex-typekey-check typekey reftex-label-menu-flags 0))           (toc (reftex-typekey-check typekey reftex-label-menu-flags 0))
497           (files (reftex-typekey-check typekey reftex-label-menu-flags 7))           (files (reftex-typekey-check typekey reftex-label-menu-flags 7))
498           (context (not (reftex-typekey-check           (context (not (reftex-typekey-check
# Line 502  When called with 2 C-u prefix args, disa Line 502  When called with 2 C-u prefix args, disa
502           (follow  (reftex-typekey-check           (follow  (reftex-typekey-check
503                     typekey reftex-label-menu-flags 4))                     typekey reftex-label-menu-flags 4))
504           (commented (nth 5 reftex-label-menu-flags))           (commented (nth 5 reftex-label-menu-flags))
505           (prefix "")           (prefix "")
506           selection-buffers           selection-buffers
507           offset rtn key data last-data entries)           offset rtn key data last-data entries)
508    
509      (unwind-protect      (unwind-protect
510          (catch 'exit          (catch 'exit
511            (while t            (while t
512              (save-window-excursion              (save-window-excursion
513                (delete-other-windows)                (delete-other-windows)
514                (setq reftex-call-back-to-this-buffer buf                (setq reftex-call-back-to-this-buffer buf
515                      reftex-latex-syntax-table (syntax-table))                      reftex-latex-syntax-table (syntax-table))
516                (let ((default-major-mode 'reftex-select-label-mode))                (let ((default-major-mode 'reftex-select-label-mode))
517                  (if reftex-use-multiple-selection-buffers                  (if reftex-use-multiple-selection-buffers
518                      (switch-to-buffer-other-window                      (switch-to-buffer-other-window
519                       (save-excursion                       (save-excursion
520                         (set-buffer buf)                         (set-buffer buf)
521                         (reftex-make-selection-buffer-name typekey)))                         (reftex-make-selection-buffer-name typekey)))
522                    (switch-to-buffer-other-window "*RefTeX Select*")                    (switch-to-buffer-other-window "*RefTeX Select*")
523                    (reftex-erase-buffer)))                    (reftex-erase-buffer)))
524                (unless (eq major-mode 'reftex-select-label-mode)                (unless (eq major-mode 'reftex-select-label-mode)
525                  (reftex-select-label-mode))                  (reftex-select-label-mode))
526                (add-to-list 'selection-buffers (current-buffer))                (add-to-list 'selection-buffers (current-buffer))
527                (setq truncate-lines t)                (setq truncate-lines t)
528                (setq mode-line-format                (setq mode-line-format
529                      (list "----  " 'mode-line-buffer-identification                      (list "----  " 'mode-line-buffer-identification
530                            "  " 'global-mode-string "   (" mode-name ")"                            "  " 'global-mode-string "   (" mode-name ")"
531                            "  S<" 'refstyle ">"                            "  S<" 'refstyle ">"
532                            " -%-"))                            " -%-"))
533                (cond                (cond
534                 ((= 0 (buffer-size))                 ((= 0 (buffer-size))
535                  (let ((buffer-read-only nil))                  (let ((buffer-read-only nil))
536                    (message "Creating Selection Buffer...")                    (message "Creating Selection Buffer...")
537                    (setq offset (reftex-insert-docstruct                    (setq offset (reftex-insert-docstruct
538                                  buf                                  buf
539                                  toc                                  toc
540                                  typekey                                  typekey
541                                  nil ; index                                  nil ; index
542                                  files                                  files
543                                  context                                  context
544                                  counter                                  counter
545                                  commented                                  commented
546                                  (or here-I-am offset)                                  (or here-I-am offset)
547                                  prefix                                  prefix
548                                  nil  ; no a toc buffer                                  nil  ; no a toc buffer
549                                  ))))                                  ))))
550                 (here-I-am                 (here-I-am
551                  (setq offset (reftex-get-offset buf here-I-am typekey)))                  (setq offset (reftex-get-offset buf here-I-am typekey)))
552                 (t (setq offset t)))                 (t (setq offset t)))
553                (setq buffer-read-only t)                (setq buffer-read-only t)
554                (setq offset (or offset t))                (setq offset (or offset t))
555    
556                (setq here-I-am nil) ; turn off determination of offset                (setq here-I-am nil) ; turn off determination of offset
557                (setq rtn                (setq rtn
558                      (reftex-select-item                      (reftex-select-item
559                       reftex-select-label-prompt                       reftex-select-label-prompt
560                       reftex-select-label-help                       reftex-select-label-help
561                       reftex-select-label-map                       reftex-select-label-map
562                       offset                       offset
563                       'reftex-show-label-location follow))                       'reftex-show-label-location follow))
564                (setq key       (car rtn)                (setq key       (car rtn)
565                      data      (nth 1 rtn)                      data      (nth 1 rtn)
566                      last-data (nth 2 rtn)                      last-data (nth 2 rtn)
567                      offset    t)                      offset    t)
568                (unless key (throw 'exit nil))                (unless key (throw 'exit nil))
569                (cond                (cond
570                 ((eq key ?g)                 ((eq key ?g)
571                  ;; update buffer                  ;; update buffer
572                  (reftex-erase-buffer))                  (reftex-erase-buffer))
573                 ((or (eq key ?r)                 ((or (eq key ?r)
574                      (eq key ?R))                      (eq key ?R))
575                  ;; rescan buffer                  ;; rescan buffer
576                  (and current-prefix-arg (setq key ?R))                  (and current-prefix-arg (setq key ?R))
577                  (reftex-erase-buffer)                  (reftex-erase-buffer)
578                  (reftex-reparse-document buf last-data key))                  (reftex-reparse-document buf last-data key))
579                 ((eq key ?c)                 ((eq key ?c)
580                  ;; toggle context mode                  ;; toggle context mode
581                  (reftex-erase-buffer)                  (reftex-erase-buffer)
582                  (setq context (not context)))                  (setq context (not context)))
583                 ((eq key ?s)                 ((eq key ?s)
584                  ;; switch type                  ;; switch type
585                  (setq here-I-am here-I-am1)                  (setq here-I-am here-I-am1)
586                  (setq typekey (reftex-query-label-type)))                  (setq typekey (reftex-query-label-type)))
587                 ((eq key ?t)                 ((eq key ?t)
588                  ;; toggle table of contents display, or change depth                  ;; toggle table of contents display, or change depth
589                  (reftex-erase-buffer)                  (reftex-erase-buffer)
590                  (if current-prefix-arg                  (if current-prefix-arg
591                      (setq reftex-toc-max-level (prefix-numeric-value                      (setq reftex-toc-max-level (prefix-numeric-value
592                                                  current-prefix-arg))                                                  current-prefix-arg))
593                    (setq toc (not toc))))                    (setq toc (not toc))))
594                 ((eq key ?F)                 ((eq key ?F)
595                  ;; toggle display of included file borders                  ;; toggle display of included file borders
596                  (reftex-erase-buffer)                  (reftex-erase-buffer)
597                  (setq files (not files)))                  (setq files (not files)))
598                 ((eq key ?#)                 ((eq key ?#)
599                  ;; toggle counter display                  ;; toggle counter display
600                  (reftex-erase-buffer)                  (reftex-erase-buffer)
601                  (setq counter (not counter)))                  (setq counter (not counter)))
602                 ((eq key ?%)                 ((eq key ?%)
603                  ;; toggle display of commented labels                  ;; toggle display of commented labels
604                  (reftex-erase-buffer)                  (reftex-erase-buffer)
605                  (setq commented (not commented)))                  (setq commented (not commented)))
606                 ((eq key ?l)                 ((eq key ?l)
607                  ;; reuse the last referenced label again                  ;; reuse the last referenced label again
608                  (setq entries reftex-last-used-reference)                  (setq entries reftex-last-used-reference)
609                  (throw 'exit t))                  (throw 'exit t))
610                 ((eq key ?x)                 ((eq key ?x)
611                  ;; select an external document                  ;; select an external document
612                  (setq xr-index (reftex-select-external-document                  (setq xr-index (reftex-select-external-document
613                                  xr-alist xr-index))                                  xr-alist xr-index))
614                  (setq buf (or (reftex-get-file-buffer-force                  (setq buf (or (reftex-get-file-buffer-force
615                                 (cdr (nth xr-index xr-alist)))                                 (cdr (nth xr-index xr-alist)))
616                                (error "Cannot switch document"))                                (error "Cannot switch document"))
617                        prefix (or (car (nth xr-index xr-alist)) ""))                        prefix (or (car (nth xr-index xr-alist)) ""))
                 (set-buffer buf)  
                 (reftex-access-scan-info))  
                ((stringp key)  
                 (setq entries  
                       (list  
                        (list  
                         (or (assoc key (symbol-value reftex-docstruct-symbol))  
                             (list key typekey)))))  
                 (throw 'exit t))  
                ((memq key '(?a ?A return))  
                 (cond  
                  (reftex-select-marked  
                   (setq entries (nreverse reftex-select-marked)))  
                  (data  
                   (setq entries (list (list data))))  
                  (t (setq entries nil)))  
                 (when entries  
                   (if (equal key ?a) (push 'concat entries))  
                   (setq reftex-last-used-reference entries))  
618                  (set-buffer buf)                  (set-buffer buf)
619                    (reftex-access-scan-info))
620                   ((stringp key)
621                    (setq entries
622                          (list
623                           (list
624                            (or (assoc key (symbol-value reftex-docstruct-symbol))
625                                (list key typekey)))))
626                  (throw 'exit t))                  (throw 'exit t))
627                 (t (error "This should not happen (reftex-offer-label-menu)"))))))                 ((memq key '(?a ?A return))
628                    (cond
629                     (reftex-select-marked
630                      (setq entries (nreverse reftex-select-marked)))
631                     (data
632                      (setq entries (list (list data))))
633                     (t (setq entries nil)))
634                    (when entries
635                      (if (equal key ?a) (push 'concat entries))
636                      (setq reftex-last-used-reference entries))
637                    (set-buffer buf)
638                    (throw 'exit t))
639                   (t (error "This should not happen (reftex-offer-label-menu)"))))))
640        (save-excursion        (save-excursion
641          (while reftex-buffers-with-changed-invisibility          (while reftex-buffers-with-changed-invisibility
642            (set-buffer (car (car reftex-buffers-with-changed-invisibility)))            (set-buffer (car (car reftex-buffers-with-changed-invisibility)))
643            (setq buffer-invisibility-spec            (setq buffer-invisibility-spec
644                  (cdr (pop reftex-buffers-with-changed-invisibility)))))                  (cdr (pop reftex-buffers-with-changed-invisibility)))))
645        (mapcar (lambda (buf) (and (buffer-live-p buf) (bury-buffer buf)))        (mapcar (lambda (buf) (and (buffer-live-p buf) (bury-buffer buf)))
646                selection-buffers)                selection-buffers)
647        (reftex-kill-temporary-buffers))        (reftex-kill-temporary-buffers))
648      ;; Add the prefixes, put together the relevant information in the form      ;; Add the prefixes, put together the relevant information in the form
649      ;; (LABEL TYPEKEY SEPARATOR) and return a list of those.      ;; (LABEL TYPEKEY SEPARATOR) and return a list of those.
650      (mapcar (lambda (x)      (mapcar (lambda (x)
651                (if (listp x)                (if (listp x)
652                    (list (concat prefix (car (car x)))                    (list (concat prefix (car (car x)))
653                          (nth 1 (car x))                          (nth 1 (car x))
654                          (nth 2 x))                          (nth 2 x))
655                  x))                  x))
656              entries)))              entries)))
657    
658  (defun reftex-reparse-document (&optional buffer data key)  (defun reftex-reparse-document (&optional buffer data key)
659    ;; Rescan the document.    ;; Rescan the document.
# Line 669  When called with 2 C-u prefix args, disa Line 669  When called with 2 C-u prefix args, disa
669    
670  (defun reftex-query-label-type ()  (defun reftex-query-label-type ()
671    ;; Ask for label type    ;; Ask for label type
672    (let ((key (reftex-select-with-char    (let ((key (reftex-select-with-char
673                reftex-type-query-prompt reftex-type-query-help 3)))                reftex-type-query-prompt reftex-type-query-help 3)))
674      (unless (member (char-to-string key) reftex-typekey-list)      (unless (member (char-to-string key) reftex-typekey-list)
675        (error "No such label type: %s" (char-to-string key)))        (error "No such label type: %s" (char-to-string key)))
676      (char-to-string key)))      (char-to-string key)))
677    
678  (defun reftex-show-label-location (data forward no-revisit  (defun reftex-show-label-location (data forward no-revisit
679                                          &optional stay error)                                          &optional stay error)
680    ;; View the definition site of a label in another window.    ;; View the definition site of a label in another window.
681    ;; DATA is an entry from the docstruct list.    ;; DATA is an entry from the docstruct list.
682    ;; FORWARD indicates if the label is likely forward from current point.    ;; FORWARD indicates if the label is likely forward from current point.
# Line 685  When called with 2 C-u prefix args, disa Line 685  When called with 2 C-u prefix args, disa
685    ;; ERROR means throw an error exception when the label cannot be found.    ;; ERROR means throw an error exception when the label cannot be found.
686    ;; If ERROR is nil, the return value of this function indicates success.    ;; If ERROR is nil, the return value of this function indicates success.
687    (let* ((this-window (selected-window))    (let* ((this-window (selected-window))
688           (errorf (if error 'error 'message))           (errorf (if error 'error 'message))
689           label file buffer re found)           label file buffer re found)
690    
691      (catch 'exit      (catch 'exit
692        (setq label (nth 0 data)        (setq label (nth 0 data)
693              file  (nth 3 data))              file  (nth 3 data))
694    
695        (unless file        (unless file
696          (funcall errorf "Unknown label - reparse might help")          (funcall errorf "Unknown label - reparse might help")
697          (throw 'exit nil))          (throw 'exit nil))
698    
699        ;; Goto the file in another window        ;; Goto the file in another window
700        (setq buffer        (setq buffer
701              (if no-revisit              (if no-revisit
702                  (reftex-get-buffer-visiting file)                  (reftex-get-buffer-visiting file)
703                (reftex-get-file-buffer-force                (reftex-get-file-buffer-force
704                 file (not reftex-keep-temporary-buffers))))                 file (not reftex-keep-temporary-buffers))))
705        (if buffer        (if buffer
706            ;; good - the file is available            ;; good - the file is available
707            (switch-to-buffer-other-window buffer)            (switch-to-buffer-other-window buffer)
708          ;; we have got a problem here.  The file does not exist.          ;; we have got a problem here.  The file does not exist.
709          ;; Let' get out of here..          ;; Let' get out of here..
710          (funcall errorf "Label %s not found" label)          (funcall errorf "Label %s not found" label)
711          (throw 'exit nil))          (throw 'exit nil))
712    
713        ;; search for that label        ;; search for that label
714        (setq re (format reftex-find-label-regexp-format (regexp-quote label)))        (setq re (format reftex-find-label-regexp-format (regexp-quote label)))
715        (setq found        (setq found
716              (if forward              (if forward
717                  (re-search-forward re nil t)                  (re-search-forward re nil t)
718                (re-search-backward re nil t)))                (re-search-backward re nil t)))
719        (unless found        (unless found
720          (goto-char (point-min))          (goto-char (point-min))
721          (unless (setq found (re-search-forward re nil t))          (unless (setq found (re-search-forward re nil t))
722            ;; Ooops.  Must be in a macro with distributed args.            ;; Ooops.  Must be in a macro with distributed args.
723            (setq found            (setq found
724                  (re-search-forward                  (re-search-forward
725                   (format reftex-find-label-regexp-format2                   (format reftex-find-label-regexp-format2
726                           (regexp-quote label)) nil t))))                           (regexp-quote label)) nil t))))
727        (if (match-end 3)        (if (match-end 3)
728            (progn            (progn
729              (reftex-highlight 0 (match-beginning 3) (match-end 3))              (reftex-highlight 0 (match-beginning 3) (match-end 3))
730              (reftex-show-entry (match-beginning 3) (match-end 3))              (reftex-show-entry (match-beginning 3) (match-end 3))
731              (recenter '(4))              (recenter '(4))
732              (unless stay (select-window this-window)))              (unless stay (select-window this-window)))
733          (select-window this-window)          (select-window this-window)
734          (funcall errorf "Label %s not found" label))          (funcall errorf "Label %s not found" label))
735        found)))        found)))
736    
737  (defvar font-lock-mode)  (defvar font-lock-mode)
# Line 744  When called with 2 C-u prefix args, disa Line 744  When called with 2 C-u prefix args, disa
744                  (re-search-forward  "[\n\r]" nil 1 n) (point))))                  (re-search-forward  "[\n\r]" nil 1 n) (point))))
745      (cond      (cond
746       ((and (boundp 'buffer-invisibility-spec) buffer-invisibility-spec       ((and (boundp 'buffer-invisibility-spec) buffer-invisibility-spec
747             (get-char-property (1+ beg-hlt) 'invisible))             (get-char-property (1+ beg-hlt) 'invisible))
748        ;; Invisible with text properties.  That is easy to change.        ;; Invisible with text properties.  That is easy to change.
749        (push (cons (current-buffer) buffer-invisibility-spec)        (push (cons (current-buffer) buffer-invisibility-spec)
750              reftex-buffers-with-changed-invisibility)              reftex-buffers-with-changed-invisibility)
751        (setq buffer-invisibility-spec nil))        (setq buffer-invisibility-spec nil))
752       ((string-match "\r" (buffer-substring beg end))       ((string-match "\r" (buffer-substring beg end))
753        ;; Invisible with selective display.  We need to copy it.        ;; Invisible with selective display.  We need to copy it.
754        (let ((string (buffer-substring-no-properties beg end)))        (let ((string (buffer-substring-no-properties beg end)))
755          (switch-to-buffer "*RefTeX Context Copy*")          (switch-to-buffer "*RefTeX Context Copy*")
756          (setq buffer-read-only nil)          (setq buffer-read-only nil)
757          (erase-buffer)          (erase-buffer)
758          (insert string)          (insert string)
759          (subst-char-in-region (point-min) (point-max) ?\r ?\n t)          (subst-char-in-region (point-min) (point-max) ?\r ?\n t)
760          (goto-char (- beg-hlt beg))          (goto-char (- beg-hlt beg))
761          (reftex-highlight 0 (1+ (- beg-hlt beg)) (1+ (- end-hlt beg)))          (reftex-highlight 0 (1+ (- beg-hlt beg)) (1+ (- end-hlt beg)))
762          (if (reftex-refontify)          (if (reftex-refontify)
763              (when (or (not (eq major-mode 'latex-mode))              (when (or (not (eq major-mode 'latex-mode))
764                        (not font-lock-mode))                        (not font-lock-mode))
765                (latex-mode)                (latex-mode)
766                (run-hook-with-args                (run-hook-with-args
767                 'reftex-pre-refontification-functions                 'reftex-pre-refontification-functions
768                 reftex-call-back-to-this-buffer 'reftex-hidden)                 reftex-call-back-to-this-buffer 'reftex-hidden)
769                (turn-on-font-lock))                (turn-on-font-lock))
770            (when (or (not (eq major-mode 'fundamental-mode))            (when (or (not (eq major-mode 'fundamental-mode))
771                      font-lock-mode)                      font-lock-mode)
772              (fundamental-mode)))              (fundamental-mode)))
773          (run-hooks 'reftex-display-copied-context-hook)          (run-hooks 'reftex-display-copied-context-hook)
774          (setq buffer-read-only t))))))          (setq buffer-read-only t))))))
775    
776  (defun reftex-varioref-vref ()  (defun reftex-varioref-vref ()
777    "Insert a reference using the `\\vref' macro from the varioref package."    "Insert a reference using the `\\vref' macro from the varioref package."
# Line 782  When called with 2 C-u prefix args, disa Line 782  When called with 2 C-u prefix args, disa
782    "Insert a reference using the `\\fref' macro from the fancyref package."    "Insert a reference using the `\\fref' macro from the fancyref package."
783    (interactive)    (interactive)
784    (let ((reftex-format-ref-function 'reftex-format-fref)    (let ((reftex-format-ref-function 'reftex-format-fref)
785          ;;(reftex-guess-label-type nil) ;FIXME do we want this????          ;;(reftex-guess-label-type nil) ;FIXME do we want this????
786          )          )
787      (reftex-reference)))      (reftex-reference)))
788  (defun reftex-fancyref-Fref ()  (defun reftex-fancyref-Fref ()
789    "Insert a reference using the `\\Fref' macro from the fancyref package."    "Insert a reference using the `\\Fref' macro from the fancyref package."
790    (interactive)    (interactive)
791    (let ((reftex-format-ref-function 'reftex-format-Fref)    (let ((reftex-format-ref-function 'reftex-format-Fref)
792          ;;(reftex-guess-label-type nil) ;FIXME do we want this????          ;;(reftex-guess-label-type nil) ;FIXME do we want this????
793          )          )
794      (reftex-reference)))      (reftex-reference)))
795    
796  (defun reftex-format-vref (label fmt)  (defun reftex-format-vref (label fmt)
# Line 802  When called with 2 C-u prefix args, disa Line 802  When called with 2 C-u prefix args, disa
802  (defun reftex-format-fref (label def-fmt)  (defun reftex-format-fref (label def-fmt)
803    (format "\\fref{%s}" label))    (format "\\fref{%s}" label))
804    
   
 ;(defun reftex-goto-label ()  
 ;  (interactive)  
 ;  (reftex-access-scan-info)  
 ;  (let* ((docstruct (symbol-value reftex-docstruct-symbol))  
 ;        (label (completing-read "Label: " docstruct  
 ;                                (lambda (x) (stringp (car x))) t))  
 ;        (selection (assoc label docstruct)))  
 ;    (reftex-show-label-location selection t nil 'stay)  
 ;    (reftex-unhighlight 0)))  
   
805  (defun reftex-goto-label (&optional other-window)  (defun reftex-goto-label (&optional other-window)
806    "Prompt for a label (with completion) and jump to the location of this label.    "Prompt for a label (with completion) and jump to the location of this label.
807  Optional prefix argument OTHER-WINDOW goes to the label in another window."  Optional prefix argument OTHER-WINDOW goes to the label in another window."
808    (interactive "P")    (interactive "P")
809    (reftex-access-scan-info)    (reftex-access-scan-info)
810    (let* ((wcfg (current-window-configuration))    (let* ((wcfg (current-window-configuration))
811           (docstruct (symbol-value reftex-docstruct-symbol))           (docstruct (symbol-value reftex-docstruct-symbol))
812           (label (completing-read "Label: " docstruct           (label (completing-read "Label: " docstruct
813                                   (lambda (x) (stringp (car x))) t))                                   (lambda (x) (stringp (car x))) t))
814           (selection (assoc label docstruct))           (selection (assoc label docstruct))
815           (where (progn           (where (progn
816                    (reftex-show-label-location selection t nil 'stay)                    (reftex-show-label-location selection t nil 'stay)
817                    (point-marker))))                    (point-marker))))
818      (unless other-window      (unless other-window
819        (set-window-configuration wcfg)        (set-window-configuration wcfg)
820        (switch-to-buffer (marker-buffer where))        (switch-to-buffer (marker-buffer where))
821        (goto-char where))        (goto-char where))      
822      (reftex-unhighlight 0)))      (reftex-unhighlight 0)))
823    
824    
825    
826    ;;; arch-tag: 52f14032-fb76-4d31-954f-750c72415675
827  ;;; reftex-ref.el ends here  ;;; reftex-ref.el ends here

Legend:
Removed from v.1.10.8.1  
changed lines
  Added in v.1.10.8.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26