1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
(* Otags III
*
* Hendrik Tews Copyright (C) 2010 - 2017
*
* This file is part of "Otags III".
*
* "Otags III" is free software: you can redistribute it and/or
* modify it under the terms of the GNU General Public License as
* published by the Free Software Foundation, either version 3 of the
* License, or (at your option) any later version.
*
* "Otags III" is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* General Public License in file COPYING in this or one of the parent
* directories for more details.
*
* You should have received a copy of the GNU General Public License
* along with "Otags III". If not, see
* <http://www.gnu.org/licenses/>.
*
* write emacs tags files
*
*)
open Global
open Otags_types
open Source_channel
open Fix_location
(* For files with INCLUDE or line directives we suddenly get tags with
* locations from different files. We cannot tag with the main source file
* because, for the line directives case, we don't know their location and,
* for the INCLUDE case, they do not occur there. We therefore maintain
* several buffers to which we append tags. They are created as needed
* and stored in a hash table, because, for the line directive case,
* it is possible that one jumps several times between two files.
*
* This buffers hash table is empty between compilation units. And the
* current buffer is some default empty buffer that is never used.
*
* If file = "" then the current_buf, file and ic fields hold only
* placeholders. Therefore filenames must be different from "".
*)
type emacs_tag_state = {
tags_oc : out_channel;
buffers : (string, Buffer.t) Hashtbl.t;
mutable current_buf : Buffer.t;
mutable file : string;
}
(* Dig out the buffer into which the tags for file are written, to
* append the next tag to the right buffer. If that buffer does not yet
* exist it is created.
*)
let make_current_buffer es file =
let buf =
try
Hashtbl.find es.buffers file
with
| Not_found ->
let buf = Buffer.create 4095 in
Hashtbl.add es.buffers file buf;
buf
in
es.current_buf <- buf;
es.file <- file
let emacs_tag_line line tag line_number char =
Printf.sprintf "%s\127%s\001%d,%d\n" line tag line_number char
let start_unit es file =
assert(file <> "");
assert(Hashtbl.length es.buffers = 0);
let mod_name = Otags_misc.module_name file in
let module_tag = emacs_tag_line "" mod_name 1 0 in
make_current_buffer es file;
Buffer.add_string es.current_buf module_tag
let write_tag es loc tag =
(* Printf.eprintf "%s: %s\n" tag (full_string_of_loc loc); *)
if es.file <> Otags_misc.file_of_loc loc
then
make_current_buffer es (Otags_misc.file_of_loc loc);
let loc = fix_loc loc in
let line_fragment =
(* if loc is wrong (eg, because of line directives) cut_out will
* throw End_of_file.
*)
try
Otags_misc.cut_out
(get_channel loc)
loc.Location.loc_start.Lexing.pos_bol
loc.Location.loc_end.Lexing.pos_cnum
with
| End_of_file ->
raise
(Otags_parsing_error(
loc,
(Printf.sprintf
("The parser delivered an invalid location "
^^ "(char position %d-%d),\n"
^^ "maybe there are line directives in the input?")
loc.Location.loc_start.Lexing.pos_bol
loc.Location.loc_end.Lexing.pos_cnum)))
in
Buffer.add_string es.current_buf
(emacs_tag_line
line_fragment
tag
loc.Location.loc_start.Lexing.pos_lnum
loc.Location.loc_start.Lexing.pos_bol)
(* Buffer, never to be really used, serves as a placeholder for the
* current_buf field between compilation units.
*)
let default_empty_buffer = Buffer.create 1
let finish_unit es () =
Hashtbl.iter (* XXX don't write empty buffers *)
(fun file buf ->
Printf.fprintf es.tags_oc "\012\n%s,%d\n"
(if !relative_file_prefix <> "" && Filename.is_relative file
then Filename.concat !relative_file_prefix file
else file)
(Buffer.length buf);
Buffer.output_buffer es.tags_oc buf;
)
es.buffers;
Hashtbl.clear es.buffers;
es.current_buf <- default_empty_buffer;
es.file <- "";
()
let finish_tagging _es () = ()
let init oc =
let es = {
tags_oc = oc;
buffers = Hashtbl.create 23;
current_buf = default_empty_buffer;
file = "";
}
in {
start_unit = start_unit es;
write_tag = write_tag es;
finish_unit = finish_unit es;
finish_tagging = finish_tagging es;
}
|
