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: make_ptags.pl,v 1.1 2008/06/30 17:43:47 jschimpf Exp $
27% ----------------------------------------------------------------------
28
29/*
30 * SEPIA PROLOG SOURCE MODULE
31 */
32
33/*
34 * IDENTIFICATION:	make_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	07.07.90
44 */
45
46:- module(make_ptags).
47
48:- use_module(library(ptags)).
49
50:- export
51	make_ptags/0,
52	make_ptags/1.
53
54% make_ptags/0
55% make_ptags
56% creates a prolog tags file "tags" for all *.pl files in the cwd
57
58make_ptags :-
59	make_ptags('tags').
60
61% make_ptags/1
62% make_ptags(Tags)
63% creates a prolog tags file Tags for all *.pl files in the cwd
64
65make_ptags(Tags) :-
66	!,
67	read_directory(., '*.pl', _, List),
68	sort(List, SList),
69	% remove files we are not interested in which hide useful tags
70	subtract(SList, ["bsi.pl", "oldio.pl"], NewList),
71	make_ptags(NewList, Tags).
72
73% make_ptags/2
74% make_ptags(List, Tags)
75
76make_ptags(X, Tags) :-
77	var(X), !,
78	error(4, make_ptags(X, Tags)).
79make_ptags([], _) :-
80	!.
81make_ptags([File|Files], Tags) :-
82	!,
83	(string(Tags) ->
84		TagsS = Tags
85	;
86		atom(Tags) ->
87		atom_string(Tags, TagsS)
88	;
89		error(5, make_ptags(File, Tags))
90	),
91	get_flag(pid, Pid),
92	concat_string(['/tmp/sepia_ptags', Pid], TempFile),
93	open(TempFile, write, TagsStream),
94	make_tags([File|Files], TagsStream),
95	close(TagsStream),
96	reset_error_handler(68),
97	concat_string(['sort +0 -1 -u ', TempFile], ShellString1),
98	concat_string([ShellString1, ' > '], ShellString2),
99	concat_strings(ShellString2, TagsS, ShellString),
100	sh(ShellString),
101	delete(TempFile).
102
103% make_tags/2
104% make_tags(File, TagsStream)
105
106make_tags([], _) :-
107	!.
108make_tags([File|Files], TagsStream) :-
109	!,
110	sepia,
111	tags(File, TagsStream),
112	make_tags(Files, TagsStream).
113
114% sepia/0
115% sepia
116% resets the compatibility to sepia
117
118sepia :-
119	( get_chtab(0'", string_quote) ->
120		true
121	;
122		set_chtab(0'", string_quote)
123	),
124	set_chtab(0'$, symbol),
125	set_chtab(0'&, symbol),
126	set_chtab(0'\, escape),
127	set_chtab(0'|, special),
128	set_chtab(128, blank_space),	% there had to be be some string_quote
129	set_flag(syntax_option, not(blanks_in_nil)),
130%	set_flag(syntax_option, not(cprolog_bar)),
131	set_flag(syntax_option, not(limit_arg_precedence)),
132	set_flag(syntax_option, not(nl_in_quotes)),
133	set_flag(syntax_option, not(no_blanks)),
134	set_error_handler(68, fail/0),	% to cope with macro expansion
135	op(500, fx,  (@)),	% introduces pce object reference
136	op(500, xfy, (:)),	% separator between pce behaviour and value
137	op(100, xfy, (/\)),
138	op(1000, fy, (nospy)),
139	op(1000, fy, (spy)),
140	op(200, xfy, (\/)),
141	op(500, fx, '+'),
142	op(500, fx, '-'),
143	op(900, fy, (not)).
144