1% ---------------------------------------------------------------------- 2% BEGIN LICENSE BLOCK 3% Version: CMPL 1.1 4% 5% The contents of this file are subject to the Cisco-style Mozilla Public 6% License Version 1.1 (the "License"); you may not use this file except 7% in compliance with the License. You may obtain a copy of the License 8% at www.eclipse-clp.org/license. 9% 10% Software distributed under the License is distributed on an "AS IS" 11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 12% the License for the specific language governing rights and limitations 13% under the License. 14% 15% The Original Code is The ECLiPSe Constraint Logic Programming System. 16% The Initial Developer of the Original Code is Cisco Systems, Inc. 17% Portions created by the Initial Developer are 18% Copyright (C) 1990-2006 Cisco Systems, Inc. All Rights Reserved. 19% 20% Contributor(s): ECRC GmbH 21% Contributor(s): IC-Parc, Imperal College London 22% 23% END LICENSE BLOCK 24% 25% System: ECLiPSe Constraint Logic Programming System 26% Version: $Id: ptags.pl,v 1.2 2009/07/16 09:11:24 jschimpf Exp $ 27% ---------------------------------------------------------------------- 28 29/* 30 * SEPIA PROLOG SOURCE MODULE 31 */ 32 33/* 34 * IDENTIFICATION: ptags.pl 35 * 36 * DESCRIPTION: Tags file creator. 37 * 38 * 39 * CONTENTS: 40 * 41 * REVISION HISTORY: 42 * AUTHOR VERSION DATE REASON 43 * Joachim Witte 1.0 26.06.90 44 */ 45 46:- module(ptags). 47 48:- comment(categories, ["Development Tools"]). 49:- comment(summary, "Tags file creator"). 50:- comment(author, " Joachim Witte, ECRC Munich"). 51:- comment(copyright, "Cisco Systems, Inc"). 52:- comment(date, "$Date: 2009/07/16 09:11:24 $"). 53:- comment(desc, html(" 54 This library provides a program that checks the source form of a 55 Prolog program and creates a tags file for use with the UNIX 56 editors ex and vi, similar to ctags(1). The library is loaded using 57 <PRE> 58 :- lib(ptags). 59 </PRE> 60 and the predicates ptags/1, ptags/2 and tags/2 become global. The 61 utility is invoked by 62 <PRE> 63 :- ptags(+File) 64 </PRE> 65 or 66 <PRE> 67 :- ptags(+File, +TagsFile) 68 </PRE> 69 +TagsFile is the name of the tags file. If +TagsFile is omitted, 70 it defaults to tags. 71 <P> 72 The tags file created by the ptags/1, 2 predicates can be used as 73 a tags file for vi or ex. A procedures specified as Name/Arity 74 can be found using the command 75 <PRE> 76 :ta Name 77 </PRE> 78 If there are several procedures with the same name and different 79 arity, the above command will find only one of them. In this case 80 the command 81 <PRE> 82 :ta Name/Arity 83 </PRE> 84 should be used. If the clauses for the procedure are not 85 consecutive or if the procedure occurs in more than one file, only 86 one occurrence will be put into the tags file. Which one it will 87 be depends on the file name and on the contents of the line that 88 is being sought by the :ta command. 89 ")). 90 91% Don't define local operators, because then operators in the tagged file 92% might become invisible (bug in ptags' module handling). 93 94:- import 95 canonical_path_name/2, 96 file_query_body/3, 97 read_/3 98 from sepia_kernel. 99 100:- export 101 ptags/1, 102 ptags/2. 103 104:- export 105 ptags_all/0, 106 tags/2, 107 tags1/2. 108 109 110:- set_error_handler(44, true/0). % because there is no way of telling 111 % whether this error occurs or not 112 113 114% Make ptags for all .pl files in the current directory 115ptags_all :- 116 read_directory('.', '*.pl', _, Files), 117 ptags(Files). 118 119 120% ptags/1 121% ptags(File) 122 123ptags(File) :- 124 ptags(File, 'tags'). 125 126% ptags/2 127% ptags(File, Tags) 128 129ptags(X, TagsStream) :- 130 recreate_read_module, 131 ptags1(X, TagsStream). 132 133ptags1(X, Tags) :- 134 var(X), !, 135 error(4, ptags(X, Tags)). 136ptags1([], _) :- 137 !. 138ptags1(library(_), _) :- 139 !. 140ptags1([File|Files], Tags) :- 141 !, 142 (string(Tags) -> 143 (TagsS = Tags) 144 ; 145 atom(Tags) -> 146 atom_string(Tags, TagsS) 147 ; 148 error(5, ptags(File, Tags)) 149 ), 150 get_flag(pid, Pid), 151 concat_string(['/tmp/sepia_ptags', Pid], TempFile), 152 open(TempFile, write, TagsStream), 153 tags1(File, TagsStream), 154 tags1(Files, TagsStream), 155 close(TagsStream), 156 concat_string(['sort +0 -1 -u ', TempFile], ShellString1), 157 concat_string([ShellString1, ' > '], ShellString2), 158 concat_string([ShellString2, TagsS], ShellString), 159 sh(ShellString), 160 delete(TempFile). 161ptags1(File, Tags) :- 162 (string(File) -> % first convert to a string 163 (FileS = File) 164 ; 165 atom(File) -> 166 atom_string(File, FileS) 167 ; 168 error(5, ptags(File, Tags)) 169 ), 170 (string(Tags) -> 171 (TagsS = Tags) 172 ; 173 atom(Tags) -> 174 atom_string(Tags, TagsS) 175 ; 176 error(5, ptags(File, Tags)) 177 ), 178 ( 179 get_flag(prolog_suffix, Suffixes), 180 member(Suffix, Suffixes), 181 Suffix \== ".sd", 182 concat_strings(FileS, Suffix, PlFile) 183 ; 184 error(171, ptags(File, Tags)) 185 ), 186 exists(PlFile), 187 !, 188 open(PlFile, read, Stream), 189 get_flag(pid, Pid), 190 concat_string(['/tmp/sepia_ptags', Pid], TempFile), 191 open(TempFile, write, TagsStream), 192 ptags_stream(Stream, PlFile, TagsStream), 193 close(Stream), 194 close(TagsStream), 195 concat_string(['sort +0 -1 -u ', TempFile], ShellString1), 196 concat_string([ShellString1, ' > '], ShellString2), 197 concat_string([ShellString2, TagsS], ShellString), 198 sh(ShellString), 199 delete(TempFile). 200 201% ptags_stream/3 202% ptags_stream(Stream, PlFile, TagsStream) 203 204ptags_stream(Stream, PlFile, TagsStream) :- 205 printf("making tags for file %w%n%b", [PlFile]), 206 read_(Stream, Term, ptags_read_module), 207 ptags_stream(Stream, 0, Term, _OldPId, _NewPId, PlFile, TagsStream). 208 209% ptags_stream/7 210% ptags_stream(Stream, Pointer, Term, OldPId, NewPId, PlFile, TagsStream) 211 212ptags_stream(_, _, end_of_file, _, _, _, _) :- 213 !. 214ptags_stream(Stream, Pointer, Term, _, NewPId, PlFile, TagsStream) :- 215 ptags_term(Pointer, Term, NewPId, PId, PlFile, TagsStream), 216 at(Stream, NewPointer), 217 read_(Stream, NewTerm, ptags_read_module), 218 ptags_stream(Stream, NewPointer, NewTerm, NewPId, PId, PlFile, TagsStream). 219 220% ptags_term/6 221% ptags_term(Pointer, Clause, OldPId, NewPId, PlFile, TagsStream) 222 223ptags_term(_, (:- Goal), _, _, _, TagsStream) :- 224 !, 225 process_query(Goal, TagsStream). 226ptags_term(_, (?- Goal), _, _, _, TagsStream) :- 227 !, 228 process_query(Goal, TagsStream). 229ptags_term(Pointer, Clause, OldPId, NewPId, PlFile, TagsStream) :- 230 ptags_pid(Clause, Head, NewPId, Atom, Arity), 231 ptags_pointer(Pointer, PlFile, TagsString), 232 (NewPId == OldPId -> 233 true 234 ; 235 write_ptags(TagsStream, Atom, Arity, PlFile, TagsString), 236 ptags_tools(Head, TagsStream, PlFile, TagsString) 237 ). 238 239ptags_tools(Head, TagsStream, PlFile, TagsString) :- 240 recorded(Head, AtomI/ArityI, Ref), 241 !, 242 write_ptags(TagsStream, AtomI, ArityI, PlFile, TagsString), 243 erase(Ref), 244 ptags_tools(Head, TagsStream, PlFile, TagsString). 245ptags_tools(_, _, _, _). 246 247process_query((A, B), TagsStream) :- 248 !, 249 process_query(A, TagsStream), 250 process_query(B, TagsStream). 251process_query(tool(PredI, F/A), _) :- 252 !, 253 functor(PredB, F, A), 254 local_record(F/A), 255 recorda(PredB, PredI). 256process_query(module(_), _) :- % a new module, we have to erase 257 !, % all operators, macros, etc. 258 recreate_read_module. % to avoid clashes 259process_query(module_interface(_), _) :- 260 !, 261 recreate_read_module. 262process_query(lib(Lib), _) :- 263 !, 264 lib(Lib, ptags_read_module). 265process_query(Goal, TagsStream) :- 266 file_query_body(Goal, tags1(_, TagsStream), ptags_read_module). 267 268% tags/2 269% tags(File, TagsStream) 270 271tags(X, TagsStream) :- 272 recreate_read_module, 273 tags1(X, TagsStream). 274 275tags1(X, TagsStream) :- 276 var(X), !, 277 error(4, tags(X, TagsStream)). 278tags1([], _) :- 279 !. 280tags1([File|Files], TagsStream) :- 281 !, 282 tags1(File, TagsStream), 283 tags1(Files, TagsStream). 284tags1(library(_), _) :- 285 !. % ignore libraries 286tags1(File, TagsStream) :- 287 (string(File) -> % first convert to a string 288 (FileS = File) 289 ; 290 atom(File) -> 291 atom_string(File, FileS) 292 ; 293 error(5, tags(File, TagsStream)) 294 ), 295 ( 296 get_flag(prolog_suffix, Suffixes), 297 member(Suffix, Suffixes), 298 Suffix \== ".sd", 299 concat_strings(FileS, Suffix, PlFile), 300 exists(PlFile), 301 !, 302 open(PlFile, read, Stream), 303 ptags_stream(Stream, PlFile, TagsStream), 304 close(Stream) 305 ; 306 printf(error, "*** Warning: file %s does not exist\n%b", [File]) 307 ). 308 309% ptags_pid/2 310% ptags_pid(Clause, Head, PId, Atom) 311 312ptags_pid((H :- _), H, PId, Atom, Arity) :- 313 !, 314 functor(H, Atom, Arity), 315 PId = Atom/Arity. 316ptags_pid(H, H, PId, Atom, Arity) :- 317 functor(H, Atom, Arity), 318 PId = Atom/Arity. 319 320% ptags_pointer/3 321% ptags_pointer(Pointer, PlFile, TagsStream) 322 323ptags_pointer(Pointer, PlFile, TagsString) :- 324 open(PlFile, read, Stream), 325 seek(Stream, Pointer), 326 read_token(Stream, _, _), 327 at(Stream, Pointer2), 328 seek(Stream, Pointer), 329 ptags_string(Stream, Pointer2, TagsString), 330 close(Stream). 331 332% ptags_string/3 333% ptags_string(Stream, Pointer2, TagsString) 334 335ptags_string(Stream, Pointer2, TagsString) :- 336 char_int(N, 10), 337 read_string(Stream, N, 80, String), % truncate long lines 338 at(Stream, Pointer), 339 ((Pointer >= Pointer2) -> 340 (TagsString = String) 341 ; 342 ptags_string(Stream, Pointer2, TagsString) 343 ). 344 345% This is mainly to get rid of local operators ... 346 347recreate_read_module :- 348 ( current_module(ptags_read_module) -> 349 erase_module(ptags_read_module) 350 ; 351 true 352 ), 353 create_module(ptags_read_module), 354 call(import(ptags), ptags_read_module). 355 356% write_ptags/5 357% write_ptags(TagsStream, Atom, Arity, PlFile, TagsString) 358 359write_ptags(TagsStream, Atom, Arity, PlFile, TagsString) :- 360 (substring(PlFile, "/", 1) -> 361 AbsFile = PlFile 362 ; 363 substring(PlFile, "~", 1) -> 364 canonical_path_name(PlFile, AbsFile) 365 ; 366 compound(PlFile) -> 367 canonical_path_name(PlFile, AbsFile) 368 ; 369 get_flag(cwd, Cwd0), 370 (substring(Cwd0, "/auto/", 1) -> 371 Len is string_length(Cwd0) - 5, 372 substring(Cwd0, 6, Len, Cwd) 373 ; 374 Cwd=Cwd0 375 ), 376 concat_string([Cwd, PlFile], AbsFile) 377 ), 378 printf(TagsStream, '%w %w /^', [Atom, AbsFile]), 379 (substring(TagsString, "/", _) -> 380 slash_for_vi(TagsStream, TagsString) 381 ; 382 write(TagsStream, TagsString) 383 ), 384 nl(TagsStream), 385 printf(TagsStream, '%w/%d %w /^', [Atom, Arity, AbsFile]), 386 (substring(TagsString, "/", _) -> 387 slash_for_vi(TagsStream, TagsString) 388 ; 389 write(TagsStream, TagsString) 390 ), 391 nl(TagsStream). 392 393% slash_for_vi/2 394% slash_for_vi(TagsStream, TagsString) 395 396slash_for_vi(TagsStream, TagsString) :- 397 ( 398 (char_int(S, 47), 399 substring(TagsString, _, 1, Char), 400 ((Char == S) -> 401 write(TagsStream, \) 402 ; 403 true 404 ), 405 put_char(TagsStream, Char), 406 fail) 407 ; 408 true 409 ). 410