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