File: vi.ml

package info (click to toggle)
otags 4.05.1-1
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 424 kB
  • ctags: 356
  • sloc: ml: 1,267; sh: 212; makefile: 194
file content (187 lines) | stat: -rw-r--r-- 4,827 bytes parent folder | download
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
(* 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 vi tags files
 * 
 *)

open Global
open Otags_types
open Source_channel
open Fix_location


type vi_tag = {
  tag : string;
  tag_file : string;
  address : string;
  (* To order the vi tags I store them in a ordered set, see 
   * module Tagset below. However, I would really need multi-sets,
   * because the same identifier might be tagged with several locations.
   * I therefore use tag_file and the character position to distinguish 
   * between the same tag that occurs at several locations.
   *)
  position : int;
}

module Ordered_tag = struct
  type t = vi_tag
  let compare tag_1 tag_2 = 
    let test_1 = compare tag_1.tag tag_2.tag in
    if test_1 <> 0 then test_1
    else
      let test_2 = compare tag_1.tag_file tag_2.tag_file in
      if test_2 <> 0 then test_2
      else
	compare tag_1.position tag_2.position
end

module Tagset = Set.Make(Ordered_tag)

(* 
 * module Tagset = struct
 *   type t = vi_tag list
 *   let add el t = el :: t
 *   let iter f t = List.iter f (List.rev t)
 *   let empty = []
 * end
 *)


(* State record for vi tags table generation. Most importantly 
 * the state contains the ordered set of all tags, to which tags are 
 * added for the whole livetime of the program. Only at the end, when all 
 * source files have been read, this set is written into the tags file
 * at tags_oc. 
 *)
type vi_state = {
  tags_oc : out_channel;
  mutable tags : Tagset.t;
}


let sorted_vi_tags_header =
  "!_TAG_FILE_FORMAT	1	/without ;\"/\n\
   !_TAG_FILE_SORTED	1	/0=unsorted, 1=sorted/\n"


(* escape all '/' and '\' in s *)
let ex_search_escape s =
  let len = String.length s in
  let n = ref len in
  for i = 0 to len - 1 do
    match s.[i] with
      | '/' -> incr n
      | '\\' -> incr n
      | _ -> ()
  done;
  if len = !n then s
  else
    let new_s = Bytes.create !n in
    let j = ref 0 in
    for i = 0 to len - 1 do
      match s.[i] with
	| '/' -> 
	  Bytes.set new_s !j '\\'; incr j;
	  Bytes.set new_s !j '/'; incr j
	| '\\' ->
	  Bytes.set new_s !j '\\'; incr j;
	  Bytes.set new_s !j '\\'; incr j
	| c ->
	  Bytes.set new_s !j c; incr j
    done;
    Bytes.to_string new_s
  

let ex_search_line line = 
  "/^" ^ (ex_search_escape line) ^ "$/"
;;

let write_vi_line oc tag =
  Printf.fprintf oc "%s\t%s\t%s;\n" 
    tag.tag 
    (if !relative_file_prefix <> "" && Filename.is_relative tag.tag_file
     then Filename.concat !relative_file_prefix tag.tag_file
     else tag.tag_file)
    tag.address


let add_tag vs tag =
  vs.tags <- Tagset.add tag vs.tags


let start_unit vs file =
  let mod_name = Otags_misc.module_name file in
  add_tag vs {tag = mod_name; tag_file = file; address = "1"; position = 0}


let write_tag vs loc tag =
  let loc = fix_loc loc in
  let loc_line =
    (* if loc is wrong (eg, because of line directives), input_line
     * will throw End_of_file.
     *)
    try
      Otags_misc.input_line_at (get_channel loc)
			       loc.Location.loc_start.Lexing.pos_bol
    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
  let address = 
    if String.length loc_line <= 1
    then string_of_int loc.Location.loc_start.Lexing.pos_lnum
    else ex_search_line loc_line
  in
  add_tag vs {tag = tag; 
	      tag_file = Otags_misc.file_of_loc loc;
	      address = address;
	      position = loc.Location.loc_start.Lexing.pos_cnum;
	     }


let finish_unit _vs () = ()

let finish_tagging vs () =
  output_string vs.tags_oc sorted_vi_tags_header;
  Tagset.iter (write_vi_line vs.tags_oc) vs.tags;
  vs.tags <- Tagset.empty


let init oc =
  let vs = {
    tags_oc = oc;
    tags = Tagset.empty;
  }
  in {
    start_unit = start_unit vs;
    write_tag = write_tag vs;
    finish_unit = finish_unit vs;
    finish_tagging = finish_tagging vs;
  }