diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improve WIN32 support and installation

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2170 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2008-03-27 00:41:33 +00:00
parent 48f393bedf
commit 1c6b91cb72
25 changed files with 45395 additions and 23748 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
C/adtdefs.c
View File

@ -273,6 +273,28 @@ LookupWideAtom(wchar_t *atom)
return na; return na;
} }
Atom
Yap_LookupMaybeWideAtom(wchar_t *atom)
{ /* lookup atom in atom table */
wchar_t *p = atom, c;
size_t len = 0;
char *ptr, *ptr0;
Atom at;
while ((c = *p++)) {
if (c > 255) return LookupWideAtom(atom);
len++;
}
/* not really a wide atom */
ptr0 = ptr = Yap_AllocCodeSpace(len+1);
if (!ptr)
return NIL;
while ((*ptr++ = *p++));
at = LookupAtom(ptr0);
Yap_FreeCodeSpace(ptr0);
return at;
}
Atom Atom
Yap_LookupAtom(char *atom) Yap_LookupAtom(char *atom)
{ /* lookup atom in atom table */ { /* lookup atom in atom table */

15
C/errors.c
View File

@ -858,6 +858,21 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE; serious = TRUE;
} }
break; break;
case EXISTENCE_ERROR_KEY:
{
int i;
Term ti[2];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(Yap_LookupAtom("key"));
ti[1] = where;
nt[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("existence_error"),2), 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = Yap_MkFunctor(Yap_LookupAtom("error"),2);
serious = TRUE;
}
break;
case EXISTENCE_ERROR_STREAM: case EXISTENCE_ERROR_STREAM:
{ {
int i; int i;

8
C/save.c
View File

@ -1431,8 +1431,12 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
int mode = FAIL_RESTORE; int mode = FAIL_RESTORE;
// Yap_ErrorMessage = NULL; // Yap_ErrorMessage = NULL;
if (inpf == NULL) if (inpf == NULL) {
inpf = StartUpFile; #if _MSC_VER || defined(__MINGW32__)
if (!(inpf = Yap_RegistryGetString("startup")))
#endif
inpf = StartUpFile;
}
#if __simplescalar__ #if __simplescalar__
/* does not implement getcwd */ /* does not implement getcwd */
strncpy(Yap_FileNameBuf,yap_pwd,YAP_FILENAME_MAX); strncpy(Yap_FileNameBuf,yap_pwd,YAP_FILENAME_MAX);

218
C/sysbits.c
View File

@ -186,6 +186,16 @@ char *libdir = NULL;
void void
Yap_InitSysPath(void) { Yap_InitSysPath(void) {
#if _MSC_VER || defined(__MINGW32__)
{
char *dir;
if ((dir = Yap_RegistryGetString("library"))) {
Yap_PutValue(Yap_LookupAtom("system_library_directory"),
MkAtomTerm(Yap_LookupAtom(dir)));
return;
}
}
#endif
strncpy(Yap_FileNameBuf, SHARE_DIR, YAP_FILENAME_MAX); strncpy(Yap_FileNameBuf, SHARE_DIR, YAP_FILENAME_MAX);
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
{ {
@ -1665,13 +1675,17 @@ TrueFileName (char *source, char *root, char *result, int in_lib)
strncpy (result, source, YAP_FILENAME_MAX); strncpy (result, source, YAP_FILENAME_MAX);
} }
#if defined(_WIN32) #if defined(_WIN32)
res1 = result; {
/* step 2 WINDOWS: replacing \ by / */ int ch;
while ((ch = *res1++)) {
if (ch == '\\' && dir_separator('\\')) { res0 = result;
res1[-1] = '/'; /* step 2 WINDOWS: replacing \ by / */
} while ((ch = *res0++)) {
} if (ch == '\\' && dir_separator('\\')) {
res0[-1] = '/';
}
}
}
#endif #endif
/* step 3: get the full file name */ /* step 3: get the full file name */
if (!dir_separator(result[0]) && !volume_header(result)) { if (!dir_separator(result[0]) && !volume_header(result)) {
@ -2657,6 +2671,193 @@ p_ld_path(void)
#ifdef _WIN32
/* This code is from SWI-Prolog by Jan Wielemaker */
#define wstreq(s,q) (wcscmp((s), (q)) == 0)
static HKEY
reg_open_key(const wchar_t *which, int create)
{ HKEY key = HKEY_CURRENT_USER;
DWORD disp;
LONG rval;
while(*which)
{ wchar_t buf[256];
wchar_t *s;
HKEY tmp;
for(s=buf; *which && !(*which == '/' || *which == '\\'); )
*s++ = *which++;
*s = '\0';
if ( *which )
which++;
if ( wstreq(buf, L"HKEY_CLASSES_ROOT") )
{ key = HKEY_CLASSES_ROOT;
continue;
} else if ( wstreq(buf, L"HKEY_CURRENT_USER") )
{ key = HKEY_CURRENT_USER;
continue;
} else if ( wstreq(buf, L"HKEY_LOCAL_MACHINE") )
{ key = HKEY_LOCAL_MACHINE;
continue;
} else if ( wstreq(buf, L"HKEY_USERS") )
{ key = HKEY_USERS;
continue;
}
if ( RegOpenKeyExW(key, buf, 0L, KEY_READ, &tmp) == ERROR_SUCCESS )
{ RegCloseKey(key);
key = tmp;
continue;
}
if ( !create )
return NULL;
rval = RegCreateKeyExW(key, buf, 0, L"", 0,
KEY_ALL_ACCESS, NULL, &tmp, &disp);
RegCloseKey(key);
if ( rval == ERROR_SUCCESS )
key = tmp;
else
return NULL;
}
return key;
}
#define MAXREGSTRLEN 1024
static void
recover_space(wchar_t *k, Atom At)
{
if (At->WStrOfAE != k)
Yap_FreeCodeSpace((char *)k);
}
static wchar_t *
WideStringFromAtom(Atom KeyAt)
{
if (IsWideAtom(KeyAt)) {
return KeyAt->WStrOfAE;
} else {
int len = strlen(KeyAt->StrOfAE);
int sz = sizeof(wchar_t)*(len+1);
char *chp = KeyAt->StrOfAE;
wchar_t *kptr, *k;
k = (wchar_t *)Yap_AllocCodeSpace(sz);
while (k == NULL) {
if (!Yap_growheap(FALSE, sz, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, MkIntegerTerm(sz), "generating key in win_registry_get_value/3");
return FALSE;
}
}
kptr = k;
while ((*kptr++ = *chp++));
return k;
}
}
static Int
p_win_registry_get_value(void)
{
DWORD type;
BYTE data[MAXREGSTRLEN];
DWORD len = sizeof(data);
wchar_t *k, *name;
HKEY key;
Term Key = Deref(ARG1);
Term Name = Deref(ARG2);
Atom KeyAt, NameAt;
if (IsVarTerm(Key)) {
Yap_Error(INSTANTIATION_ERROR,Key,"argument to win_registry_get_value unbound");
return FALSE;
}
if (!IsAtomTerm(Key)) {
Yap_Error(TYPE_ERROR_ATOM,Key,"argument to win_registry_get_value");
return FALSE;
}
KeyAt = AtomOfTerm(Key);
if (IsVarTerm(Name)) {
Yap_Error(INSTANTIATION_ERROR,Key,"argument to win_registry_get_value unbound");
return FALSE;
}
if (!IsAtomTerm(Name)) {
Yap_Error(TYPE_ERROR_ATOM,Key,"argument to win_registry_get_value");
return FALSE;
}
NameAt = AtomOfTerm(Name);
k = WideStringFromAtom(KeyAt);
if ( !(key=reg_open_key(k, FALSE)) ) {
Yap_Error(EXISTENCE_ERROR_KEY, Key, "argument to win_registry_get_value");
recover_space(k, KeyAt);
return FALSE;
}
name = WideStringFromAtom(NameAt);
if ( RegQueryValueExW(key, name, NULL, &type, data, &len) == ERROR_SUCCESS ) {
RegCloseKey(key);
switch(type) {
case REG_SZ:
recover_space(k, KeyAt);
recover_space(name, NameAt);
((wchar_t *)data)[len] = '\0';
return Yap_unify(MkAtomTerm(Yap_LookupMaybeWideAtom((wchar_t *)data)),ARG3);
case REG_DWORD:
recover_space(k, KeyAt);
recover_space(name, NameAt);
return Yap_unify(MkIntegerTerm(*((DWORD *)data)),ARG3);
default:
recover_space(k, KeyAt);
recover_space(name, NameAt);
return FALSE;
}
}
recover_space(k, KeyAt);
recover_space(name, NameAt);
return FALSE;
}
char *
Yap_RegistryGetString(char *name)
{
DWORD type;
BYTE data[MAXREGSTRLEN];
DWORD len = sizeof(data);
HKEY key;
char *ptr;
int i;
if ( !(key=reg_open_key(L"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog", FALSE)) ) {
return NULL;
}
if ( RegQueryValueEx(key, name, NULL, &type, data, &len) == ERROR_SUCCESS ) {
RegCloseKey(key);
switch(type) {
case REG_SZ:
ptr = malloc(len+2);
if (!ptr)
return NULL;
for (i=0; i<= len; i++)
ptr[i] = data[i];
ptr[len+1] = '\0';
return ptr;
default:
return NULL;
}
}
return NULL;
}
#endif
void void
Yap_InitSysPreds(void) Yap_InitSysPreds(void)
{ {
@ -2686,6 +2887,9 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag); Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);
Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag); Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag);
Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag); Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag);
#ifdef _WIN32
Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0);
#endif
CurrentModule = SYSTEM_MODULE; CurrentModule = SYSTEM_MODULE;
Yap_InitCPred ("true_file_name", 2, p_true_file_name, SyncPredFlag); Yap_InitCPred ("true_file_name", 2, p_true_file_name, SyncPredFlag);
Yap_InitCPred ("true_file_name", 3, p_true_file_name3, SyncPredFlag); Yap_InitCPred ("true_file_name", 3, p_true_file_name3, SyncPredFlag);

12
CLPBN/Makefile.in
View File

@ -55,25 +55,27 @@ CLPBN_LEARNING_PROGRAMS= \
$(CLPBN_LEARNING_SRCDIR)/learn_utils.yap \ $(CLPBN_LEARNING_SRCDIR)/learn_utils.yap \
$(CLPBN_LEARNING_SRCDIR)/mle.yap $(CLPBN_LEARNING_SRCDIR)/mle.yap
CLPBN_EXAMPLES= \ CLPBN_SCHOOL_EXAMPLES= \
$(CLPBN_EXDIR)/cg.yap \
$(CLPBN_EXDIR)/School/README \ $(CLPBN_EXDIR)/School/README \
$(CLPBN_EXDIR)/School/evidence_128.yap \ $(CLPBN_EXDIR)/School/evidence_128.yap \
$(CLPBN_EXDIR)/School/schema.yap \ $(CLPBN_EXDIR)/School/schema.yap \
$(CLPBN_EXDIR)/School/school_128.yap \ $(CLPBN_EXDIR)/School/school_128.yap \
$(CLPBN_EXDIR)/School/school_32.yap \ $(CLPBN_EXDIR)/School/school_32.yap \
$(CLPBN_EXDIR)/School/school_64.yap \ $(CLPBN_EXDIR)/School/school_64.yap \
$(CLPBN_EXDIR)/School/tables.yap \ $(CLPBN_EXDIR)/School/tables.yap
CLPBN_EXAMPLES= \
$(CLPBN_EXDIR)/cg.yap \
$(CLPBN_EXDIR)/sprinkler.yap $(CLPBN_EXDIR)/sprinkler.yap
install: $(CLBN_TOP) $(CLBN_PROGRAMS) $(CLPBN_PROGRAMS) install: $(CLBN_TOP) $(CLBN_PROGRAMS) $(CLPBN_PROGRAMS)
mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn
mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn/learning mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn/learning
mkdir -p $(DESTDIR)$(SHAREDIR)/examples
mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn/examples/School mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn/examples/School
for h in $(CLPBN_TOP); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR); done for h in $(CLPBN_TOP); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR); done
for h in $(CLPBN_PROGRAMS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn; done for h in $(CLPBN_PROGRAMS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn; done
for h in $(CLPBN_LEARNING_PROGRAMS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn/learning; done for h in $(CLPBN_LEARNING_PROGRAMS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn/learning; done
for h in $(CLPBN_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/examples; done for h in $(CLPBN_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn/examples; done
for h in $(CLPBN_SCHOOL_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn/examples/School; done

3
H/Yap.h
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 * * File: Yap.h.m4 *
* mods: * * mods: *
* comments: main header file for YAP * * comments: main header file for YAP *
* version: $Id: Yap.h,v 1.30 2008-03-25 22:03:13 vsc Exp $ * * version: $Id: Yap.h,v 1.31 2008-03-27 00:41:32 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#include "config.h" #include "config.h"
@ -442,6 +442,7 @@ typedef enum
EVALUATION_ERROR_UNDERFLOW, EVALUATION_ERROR_UNDERFLOW,
EVALUATION_ERROR_ZERO_DIVISOR, EVALUATION_ERROR_ZERO_DIVISOR,
EXISTENCE_ERROR_ARRAY, EXISTENCE_ERROR_ARRAY,
EXISTENCE_ERROR_KEY,
EXISTENCE_ERROR_SOURCE_SINK, EXISTENCE_ERROR_SOURCE_SINK,
EXISTENCE_ERROR_STREAM, EXISTENCE_ERROR_STREAM,
INSTANTIATION_ERROR, INSTANTIATION_ERROR,

6
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.84 2008-03-26 14:37:08 vsc Exp $ * * version: $Id: Yapproto.h,v 1.85 2008-03-27 00:41:32 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -28,6 +28,7 @@ Term STD_PROTO(Yap_ArrayToList,(Term *,int));
int STD_PROTO(Yap_GetName,(char *,UInt,Term)); int STD_PROTO(Yap_GetName,(char *,UInt,Term));
Term STD_PROTO(Yap_GetValue,(Atom)); Term STD_PROTO(Yap_GetValue,(Atom));
Atom STD_PROTO(Yap_LookupAtom,(char *)); Atom STD_PROTO(Yap_LookupAtom,(char *));
Atom STD_PROTO(Yap_LookupMaybeWideAtom,(wchar_t *));
Atom STD_PROTO(Yap_FullLookupAtom,(char *)); Atom STD_PROTO(Yap_FullLookupAtom,(char *));
void STD_PROTO(Yap_LookupAtomWithAddress,(char *,AtomEntry *)); void STD_PROTO(Yap_LookupAtomWithAddress,(char *,AtomEntry *));
Prop STD_PROTO(Yap_NewPredPropByFunctor,(struct FunctorEntryStruct *, Term)); Prop STD_PROTO(Yap_NewPredPropByFunctor,(struct FunctorEntryStruct *, Term));
@ -309,6 +310,9 @@ void STD_PROTO(Yap_InitTime,(void));
int STD_PROTO(Yap_TrueFileName, (char *, char *, int)); int STD_PROTO(Yap_TrueFileName, (char *, char *, int));
int STD_PROTO(Yap_ProcessSIGINT,(void)); int STD_PROTO(Yap_ProcessSIGINT,(void));
double STD_PROTO(Yap_random, (void)); double STD_PROTO(Yap_random, (void));
#ifdef _WIN32
char *STD_PROTO(Yap_RegistryGetString,(char *));
#endif
/* threads.c */ /* threads.c */
void STD_PROTO(Yap_InitThreadPreds,(void)); void STD_PROTO(Yap_InitThreadPreds,(void));

2
LGPL/chr/chr_swi_bootstrap.yap
View File

@ -4,6 +4,8 @@
:- add_to_path('.'). :- add_to_path('.').
:- use_module(library(swi)).
:- yap_flag(unknown,error). :- yap_flag(unknown,error).
:- include('chr_swi_bootstrap.pl'). :- include('chr_swi_bootstrap.pl').

25832
LGPL/chr/chr_translate.pl
View File

File diff suppressed because it is too large Load Diff

25988
LGPL/chr/guard_entailment.pl
View File

File diff suppressed because it is too large Load Diff

75
LGPL/swi_console/Makefile.in Normal file
View File

@ -0,0 +1,75 @@
#
# default base directory for YAP installation
# (EROOT for architecture-dependent files)
#
prefix = @prefix@
ROOTDIR = $(prefix)
EROOTDIR = @exec_prefix@
#
# where YAP should look for libraries
#
LIBDIR=$(EROOTDIR)/lib/Yap
#
#
CC=@CC@
CPPFLAGS=@CPPFLAGS@
CFLAGS= @CFLAGS@ $(DEFS) $(CPPFLAGS) -I$(srcdir)
#
#
# You shouldn't need to change what follows.
#
INSTALL=@INSTALL@
INSTALL_DATA=@INSTALL_DATA@
INSTALL_PROGRAM=@INSTALL_PROGRAM@
RANLIB=@RANLIB@
AR=@AR@
srcdir=@srcdir@
SOURCES= \
$(srcdir)/complete.c $(srcdir)/console.c \
$(srcdir)/edit.c $(srcdir)/history.c \
$(srcdir)/menu.c
HEADERS= \
$(srcdir)/common.h $(srcdir)/console.h \
$(srcdir)/console_i.h $(srcdir)/history.h \
$(srcdir)/menu.h
OBJECTS= complete.o console.o edit.o history.o menu.o
LIBS=-lgdi32 -lcomdlg32
all: plterm.dll
plterm.dll: libplterm.a
$(CC) $(CFLAGS) -shared -o plterm.dll \
-Wl,--export-all-symbols \
-Wl,--enable-auto-import \
-Wl,--whole-archive libplterm.a \
-Wl,--no-whole-archive $(LIBS) $(LDFLAGS)
libplterm.a: $(OBJECTS) $(SOURCES) $(HEADERS)
-rm -f libplterm.a
$(AR) rc libplterm.a $(OBJECTS)
$(RANLIB) libplterm.a
install: plterm.dll
$(INSTALL_PROGRAM) plterm.dll $(DESTDIR)$(LIBDIR)
clean:
rm -f *.o *~ *.dll
complete.o: $(srcdir)/complete.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/complete.c -o complete.o
console.o: $(srcdir)/console.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/console.c -o console.o
history.o: $(srcdir)/history.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/history.c -o history.o
menu.o: $(srcdir)/menu.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/menu.c -o menu.o
edit.o: $(srcdir)/edit.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/edit.c -o edit.o

92
LGPL/swi_console/README Normal file
View File

@ -0,0 +1,92 @@
Win32 `Readline Console'
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
Purpose
=======
The `readline console' provides a simple, but reasonable powerful
console window for running standard I/O based applications that may wish
to access Windows functions.
The console window is inspired by both the X11 xterm application and the
GNU readline library. The text is buffered to provide for window
resizing and scroll-back. When reading input by line, an Emacs like
editor is provided for editing the input line. Old input lines are
remembered and used by the history system.
Edit functions
==============
The following edit functions are provided:
Control-A Beginning of line
Control-B Character backward
Control-C Generate interrupt
Control-D Delete character forwards, or end-of-file
Control-E End of line
Control-F Character forwards
Control-I (TAB) Complete (filename, may be programmed)
Control-J (NL) Enter (make line available)
Control-K Delete to end-of-line
Control-M (RET) Enter (make line available)
Control-N Next line in history
Control-P Previous line in history
Control-T Toggle characters around caret
Control-U Empty line
Control-V Paste
Control-Z End-of-file
DEL Delete character forwards
BACKSPACE Delete character backwards
<-, -> Move caret in line, with SHIFT down, move
by word.
Up, down Move in history list
Mouse-bindings:
Left: Start selection, dragging extends the selection.
Double-click selects in `word-mode'. The
selection is placed on the Windows clipboard.
Middle: Paste the Windows clipboard (also Control-V).
Right: Extends the selection.
Compilation:
============
Includes a project file for MSVC 4.2. Please inspect the settings first.
plterm.dll is made from console.c, edit.c and history.c
Settings:
=========
Settings are kept in the Windows registry under the key
Software\<vendor>\<program>\Console
Where
<vendor> is SWI, unless compiled with a different setting for
RLC_VENDOR
<program> is the basename of the program without extension
(i.e. plwin for the program C:\Program
Files\pl\bin\plwin.exe).
Maintained values on this key are:
Name Type Description
================================================================
SaveLines int (200-100000) # lines saved for scrollback
Width int (20-300) # width in characters
Height int (5-100) # height in characters
X int (0-screen-width) # X-position of window
Y int (0-screen-height) # Y-position of window
FaceName str # Font info (settable using
FontFamily int # extension of Windows menu)
FontSize int
FontWeight int
FontCharSet int

122
LGPL/swi_console/complete.c Normal file
View File

@ -0,0 +1,122 @@
/* $Id: complete.c,v 1.1 2008-03-27 00:41:33 vsc Exp $
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#include <windows.h>
#include <tchar.h>
#include "console.h"
typedef wint_t _TINT;
#ifndef EOS
#define EOS 0
#endif
static TCHAR *completion_chars = TEXT("~:\\/-.");
static size_t
complete_scan_backwards(Line ln, size_t from)
{ while( from > 0 )
{ _TINT c = ln->data[from-1];
if ( rlc_is_word_char(c) ||
_tcschr(completion_chars, c) )
from--;
else
break;
}
return from;
}
static __inline int
close_quote(int c)
{ return (c == '\'' || c == '"') ? c : 0;
}
int
rlc_complete_file_function(RlcCompleteData data)
{ Line ln = data->line;
WIN32_FIND_DATA fdata;
switch(data->call_type)
{ case COMPLETE_INIT:
{ size_t start = complete_scan_backwards(ln, ln->point);
TCHAR *pattern = data->buf_handle;
TCHAR *s = pattern;
size_t n = start;
size_t ld = start;
HANDLE h;
if ( ln->point - start > 200 )
return FALSE;
for( ; n < ln->point; n++)
{ int c = ln->data[n];
if ( c == '/' )
c = '\\';
if ( c == '\\' )
ld = n + 1;
*s++ = c;
}
*s++ = '*';
*s = EOS;
if ( (h=FindFirstFile(pattern, &fdata)) != INVALID_HANDLE_VALUE )
{ data->replace_from = (int)ld;
if ( start > 0 &&
!(fdata.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) )
data->quote = close_quote(ln->data[start-1]);
_tcscpy(data->candidate, fdata.cFileName);
data->ptr_handle = h;
data->case_insensitive = TRUE;
data->function = rlc_complete_file_function;
return TRUE;
}
return FALSE;
}
case COMPLETE_ENUMERATE:
{ if ( FindNextFile(data->ptr_handle, &fdata) )
{ _tcscpy(data->candidate, fdata.cFileName);
return TRUE;
}
return FALSE;
}
case COMPLETE_CLOSE:
{ FindClose(data->ptr_handle);
return FALSE;
}
default:
return FALSE;
}
}

3659
LGPL/swi_console/console.c Normal file
View File

File diff suppressed because it is too large Load Diff

741
LGPL/swi_console/edit.c Normal file
View File

@ -0,0 +1,741 @@
/* $Id: edit.c,v 1.1 2008-03-27 00:41:33 vsc Exp $
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#define _MAKE_DLL 1
#undef _export
#include <windows.h>
#include <tchar.h>
#include "console.h"
#include "console_i.h"
#include "common.h"
#include <memory.h>
#include <string.h>
#include <ctype.h>
#ifndef EOF
#define EOF -1
#endif
typedef void (*function)(Line ln, int chr); /* edit-function */
static function dispatch_table[256]; /* general dispatch-table */
static function dispatch_meta[256]; /* ESC-char dispatch */
static RlcCompleteFunc _rlc_complete_function = rlc_complete_file_function;
static void init_line_package(RlcData b);
static void bind_actions(void);
#ifndef min
#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
#endif
#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
#ifndef EOS
#define EOS 0
#endif
#ifndef ESC
#define ESC 27
#endif
#define COMPLETE_NEWLINE 1
#define COMPLETE_EOF 2
#define ctrl(c) ((c) - '@')
#define META_OFFSET 128
#define meta(c) ((c) + META_OFFSET)
/*******************************
* BUFFER *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
make_room(Line, int room)
Make n-characters space after the point.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static void
make_room(Line ln, size_t room)
{ while ( ln->size + room + 1 > ln->allocated )
{ if ( !ln->data )
{ ln->data = rlc_malloc(256 * sizeof(TCHAR));
ln->allocated = 256;
} else
{ ln->allocated *= 2;
ln->data = rlc_realloc(ln->data, ln->allocated * sizeof(TCHAR));
}
}
memmove(&ln->data[ln->point + room], &ln->data[ln->point],
(ln->size - ln->point)*sizeof(TCHAR));
ln->size += room;
if ( room > 0 )
ln->change_start = min(ln->change_start, ln->point);
}
static void
set_line(Line ln, const TCHAR *s)
{ size_t len = _tcslen(s);
ln->size = ln->point = 0;
make_room(ln, len);
_tcsncpy(ln->data, s, len);
}
static void
terminate(Line ln)
{ if ( !ln->data )
{ ln->data = rlc_malloc(sizeof(TCHAR));
ln->allocated = 1;
}
ln->data[ln->size] = EOS;
}
static void
delete(Line ln, size_t from, size_t len)
{ if ( from < 0 || from > ln->size || len < 0 || from + len > ln->size )
return;
_tcsncpy(&ln->data[from], &ln->data[from+len], ln->size - (from+len));
ln->size -= len;
}
/*******************************
* POSITIONING *
*******************************/
static size_t
back_word(Line ln, size_t from)
{ from = min(from, ln->size);
from = max(0, from);
if ( ln->data )
{ while(!rlc_is_word_char(ln->data[from-1]) && from > 0 )
from--;
while(rlc_is_word_char(ln->data[from-1]) && from > 0 )
from--;
}
return from;
}
static size_t
forw_word(Line ln, size_t from)
{ from = min(from, ln->size);
from = max(0, from);
if ( ln->data )
{ while(!rlc_is_word_char(ln->data[from]) && from < ln->size )
from++;
while(rlc_is_word_char(ln->data[from]) && from < ln->size )
from++;
}
return from;
}
/*******************************
* EDITING FUNCTIONS *
*******************************/
static __inline void
changed(Line ln, size_t from)
{ ln->change_start = min(ln->change_start, from);
}
static void
insert_self(Line ln, int chr)
{ make_room(ln, 1);
ln->data[ln->point++] = chr;
}
static void
backward_delete_character(Line ln, int chr)
{ if ( ln->point > 0 )
{ memmove(&ln->data[ln->point-1], &ln->data[ln->point],
(ln->size - ln->point)*sizeof(TCHAR));
ln->size--;
ln->point--;
}
changed(ln, ln->point);
}
static void
delete_character(Line ln, int chr)
{ if ( ln->point < ln->size )
{ ln->point++;
backward_delete_character(ln, chr);
}
}
static void
backward_character(Line ln, int chr)
{ if ( ln->point > 0 )
ln->point--;
}
static void
forward_character(Line ln, int chr)
{ if ( ln->point < ln->size )
ln->point++;
}
static void
backward_word(Line ln, int chr)
{ ln->point = back_word(ln, ln->point);
}
static void
forward_word(Line ln, int chr)
{ ln->point = forw_word(ln, ln->point);
}
static void
backward_delete_word(Line ln, int chr)
{ size_t from = back_word(ln, ln->point);
memmove(&ln->data[from], &ln->data[ln->point],
(ln->size - ln->point)*sizeof(TCHAR));
ln->size -= ln->point - from;
ln->point = from;
changed(ln, from);
}
static void
forward_delete_word(Line ln, int chr)
{ size_t to = forw_word(ln, ln->point);
memmove(&ln->data[ln->point], &ln->data[to], (ln->size - to)*sizeof(TCHAR));
ln->size -= to - ln->point;
changed(ln, ln->point);
}
static void
transpose_chars(Line ln, int chr)
{ if ( ln->point > 0 && ln->point < ln->size )
{ int c0 = ln->data[ln->point-1];
ln->data[ln->point-1] = ln->data[ln->point];
ln->data[ln->point] = c0;
changed(ln, ln->point-1);
}
}
static void
start_of_line(Line ln, int chr)
{ ln->point = 0;
}
static void
end_of_line(Line ln, int chr)
{ ln->point = ln->size;
}
static void
kill_line(Line ln, int chr)
{ ln->size = ln->point;
changed(ln, ln->size);
}
static void
empty_line(Line ln, int chr)
{ ln->size = ln->point = 0;
changed(ln, 0);
}
static void
enter(Line ln, int chr)
{ ln->point = ln->size;
#ifdef DOS_CRNL
make_room(ln, 2);
ln->data[ln->point++] = '\r';
ln->data[ln->point++] = '\n';
#else
make_room(ln, 1);
ln->data[ln->point++] = '\n';
#endif
terminate(ln);
ln->complete = COMPLETE_NEWLINE;
}
static void
eof(Line ln, int chr)
{ ln->point = ln->size;
terminate(ln);
ln->complete = COMPLETE_EOF;
}
static void
delete_character_or_eof(Line ln, int chr)
{ if ( ln->size == 0 )
{ ln->point = ln->size;
terminate(ln);
ln->complete = COMPLETE_EOF;
} else
delete_character(ln, chr);
}
static void
undefined(Line ln, int chr)
{
}
static void
interrupt(Line ln, int chr)
{ raise(SIGINT);
}
/*******************************
* HISTORY *
*******************************/
static void
add_history(rlc_console c, const TCHAR *data)
{ const TCHAR *s = data;
while(*s && *s <= ' ')
s++;
if ( *s )
rlc_add_history(c, s);
}
static void
backward_history(Line ln, int chr)
{ const TCHAR *h;
if ( rlc_at_head_history(ln->console) && ln->size > 0 )
{ terminate(ln);
add_history(ln->console, ln->data);
}
if ( (h = rlc_bwd_history(ln->console)) )
{ set_line(ln, h);
ln->point = ln->size;
}
}
static void
forward_history(Line ln, int chr)
{ if ( !rlc_at_head_history(ln->console) )
{ const TCHAR *h = rlc_fwd_history(ln->console);
if ( h )
{ set_line(ln, h);
ln->point = ln->size;
}
} else
empty_line(ln, chr);
}
/*******************************
* COMPLETE *
*******************************/
RlcCompleteFunc
rlc_complete_hook(RlcCompleteFunc new)
{ RlcCompleteFunc old = _rlc_complete_function;
_rlc_complete_function = new;
return old;
}
static int
common(const TCHAR *s1, const TCHAR *s2, int insensitive)
{ int n = 0;
if ( !insensitive )
{ while(*s1 && *s1 == *s2)
{ s1++, s2++;
n++;
}
return n;
} else
{ while(*s1)
{ if ( _totlower(*s1) == _totlower(*s2) )
{ s1++, s2++;
n++;
} else
break;
}
return n;
}
}
static void
complete(Line ln, int chr)
{ if ( _rlc_complete_function )
{ rlc_complete_data dbuf;
RlcCompleteData data = &dbuf;
memset(data, 0, sizeof(dbuf));
data->line = ln;
data->call_type = COMPLETE_INIT;
if ( (*_rlc_complete_function)(data) )
{ TCHAR match[COMPLETE_MAX_WORD_LEN];
int nmatches = 1;
size_t ncommon = _tcslen(data->candidate);
size_t patlen = ln->point - data->replace_from;
_tcscpy(match, data->candidate);
data->call_type = COMPLETE_ENUMERATE;
while( (*data->function)(data) )
{ ncommon = common(match, data->candidate, data->case_insensitive);
match[ncommon] = EOS;
nmatches++;
}
data->call_type = COMPLETE_CLOSE;
(*data->function)(data);
delete(ln, data->replace_from, patlen);
ln->point = data->replace_from;
make_room(ln, ncommon);
_tcsncpy(&ln->data[data->replace_from], match, ncommon);
ln->point += ncommon;
if ( nmatches == 1 && data->quote )
insert_self(ln, data->quote);
}
}
}
#define MAX_LIST_COMPLETIONS 256
static void
list_completions(Line ln, int chr)
{ if ( _rlc_complete_function )
{ rlc_complete_data dbuf;
RlcCompleteData data = &dbuf;
memset(data, 0, sizeof(dbuf));
data->line = ln;
data->call_type = COMPLETE_INIT;
if ( (*_rlc_complete_function)(data) )
{ TCHAR *buf[COMPLETE_MAX_MATCHES];
int n, nmatches = 0;
size_t len = _tcslen(data->candidate) + 1;
size_t longest = len;
size_t cols;
buf[nmatches] = rlc_malloc(len*sizeof(TCHAR));
_tcsncpy(buf[nmatches], data->candidate, len);
nmatches++;
data->call_type = COMPLETE_ENUMERATE;
while( (*data->function)(data) )
{ len = _tcslen(data->candidate) + 1;
buf[nmatches] = rlc_malloc(len*sizeof(TCHAR));
_tcsncpy(buf[nmatches], data->candidate, len);
nmatches++;
longest = max(longest, len);
if ( nmatches > COMPLETE_MAX_MATCHES )
{ TCHAR *msg = _T("\r\n! Too many matches\r\n");
while(*msg)
rlc_putchar(ln->console, *msg++);
ln->reprompt = TRUE;
data->call_type = COMPLETE_CLOSE;
(*data->function)(data);
return;
}
}
data->call_type = COMPLETE_CLOSE;
(*data->function)(data);
cols = ScreenCols(ln->console) / longest;
rlc_putchar(ln->console, '\r');
rlc_putchar(ln->console, '\n');
for(n=0; n<nmatches; )
{ TCHAR *s = buf[n];
len = 0;
while(*s)
{ len++;
rlc_putchar(ln->console, *s++);
}
rlc_free(buf[n++]);
if ( n % cols == 0 )
{ rlc_putchar(ln->console, '\r');
rlc_putchar(ln->console, '\n');
} else
{ while( len++ < longest )
rlc_putchar(ln->console, ' ');
}
}
if ( nmatches % cols != 0 )
{ rlc_putchar(ln->console, '\r');
rlc_putchar(ln->console, '\n');
}
ln->reprompt = TRUE;
}
}
}
/*******************************
* REPAINT *
*******************************/
static void
output(rlc_console b, TCHAR *s, size_t len)
{ while(len-- > 0)
{ if ( *s == '\n' )
rlc_putchar(b, '\r');
rlc_putchar(b, *s++);
}
}
static void
update_display(Line ln)
{ if ( ln->reprompt )
{ const TCHAR *prompt = rlc_prompt(ln->console, NULL);
const TCHAR *s = prompt;
rlc_putchar(ln->console, '\r');
while(*s)
rlc_putchar(ln->console, *s++);
rlc_get_mark(ln->console, &ln->origin);
ln->change_start = 0;
ln->reprompt = FALSE;
}
rlc_goto_mark(ln->console, &ln->origin, ln->data, ln->change_start);
output(ln->console,
&ln->data[ln->change_start], ln->size - ln->change_start);
rlc_erase_from_caret(ln->console);
rlc_goto_mark(ln->console, &ln->origin, ln->data, ln->point);
rlc_update(ln->console);
ln->change_start = ln->size;
}
/*******************************
* TOPLEVEL *
*******************************/
TCHAR *
read_line(rlc_console b)
{ line ln;
init_line_package(b);
memset(&ln, 0, sizeof(line));
ln.console = b;
rlc_get_mark(b, &ln.origin);
while(!ln.complete)
{ int c;
rlc_mark m0, m1;
function func;
rlc_get_mark(b, &m0);
if ( (c = getch(b)) == IMODE_SWITCH_CHAR )
return RL_CANCELED_CHARP;
if ( c == EOF )
{ eof(&ln, c);
update_display(&ln);
break;
} else if ( c == ESC )
{ if ( (c = getch(b)) == IMODE_SWITCH_CHAR )
return RL_CANCELED_CHARP;
if ( c > 256 )
func = undefined;
else
func = dispatch_meta[c&0xff];
} else
{ if ( c >= 256 )
func = insert_self;
else
func = dispatch_table[c&0xff];
}
rlc_get_mark(b, &m1);
(*func)(&ln, c);
if ( m0.mark_x != m1.mark_x || m0.mark_y != m1.mark_y )
ln.reprompt = TRUE;
update_display(&ln);
}
rlc_clearprompt(b);
add_history(b, ln.data);
return ln.data;
}
/*******************************
* DISPATCH *
*******************************/
static void
init_dispatch_table()
{ static int done;
if ( !done )
{ int n;
for(n=0; n<32; n++)
dispatch_table[n] = undefined;
for(n=32; n<256; n++)
dispatch_table[n] = insert_self;
for(n=0; n<256; n++)
dispatch_meta[n] = undefined;
bind_actions();
done = TRUE;
}
}
static void
init_line_package(RlcData b)
{ init_dispatch_table();
rlc_init_history(b, 50);
}
/*******************************
* BIND *
*******************************/
typedef struct _action
{ char *name;
function function;
unsigned char keys[4];
} action, *Action;
#define ACTION(n, f, k) { n, f, k }
static action actions[] = {
ACTION("insert_self", insert_self, ""),
ACTION("backward_delete_character", backward_delete_character, "\b"),
ACTION("complete", complete, "\t"),
ACTION("enter", enter, "\r\n"),
ACTION("start_of_line", start_of_line, {ctrl('A')}),
ACTION("backward_character", backward_character, {ctrl('B')}),
ACTION("interrupt", interrupt, {ctrl('C')}),
ACTION("end_of_line", end_of_line, {ctrl('E')}),
ACTION("forward_character", forward_character, {ctrl('F')}),
ACTION("transpose_chars", transpose_chars, {ctrl('T')}),
ACTION("kill_line", kill_line, {ctrl('K')}),
ACTION("backward_history", backward_history, {ctrl('P')}),
ACTION("forward_history", forward_history, {ctrl('N')}),
ACTION("empty_line", empty_line, {ctrl('U')}),
ACTION("eof", eof, {ctrl('Z')}),
ACTION("delete_character_or_eof", delete_character_or_eof, {ctrl('D')}),
ACTION("delete_character", delete_character, {127}),
{ "forward_word", forward_word, {meta(ctrl('F')), meta('f')}},
{ "backward_word", backward_word, {meta(ctrl('B')), meta('b')}},
{ "forward_delete_word", forward_delete_word, {meta(127), meta('d')}},
ACTION("list_completions", list_completions, {meta('?')}),
ACTION("backward_delete_word", backward_delete_word, {meta('\b')}),
ACTION(NULL, NULL, "")
};
int
rlc_bind(int chr, const char *fname)
{ if ( chr >= 0 && chr <= 256 )
{ Action a = actions;
for( ; a->name; a++ )
{ if ( strcmp(a->name, fname) == 0 )
{ if ( chr > META_OFFSET )
dispatch_meta[chr-META_OFFSET] = a->function;
else
dispatch_table[chr] = a->function;
return TRUE;
}
}
}
return FALSE;
}
static void
bind_actions()
{ Action a = actions;
for( ; a->name; a++ )
{ unsigned char *k = a->keys;
for( ; *k; k++ )
{ int chr = *k & 0xff;
if ( chr > META_OFFSET )
dispatch_meta[chr-META_OFFSET] = a->function;
else
dispatch_table[chr] = a->function;
}
}
}

160
LGPL/swi_console/history.c Normal file
View File

@ -0,0 +1,160 @@
/* $Id: history.c,v 1.1 2008-03-27 00:41:33 vsc Exp $
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#define _MAKE_DLL 1
#undef _export
#include <windows.h>
#include <tchar.h>
#include "console.h" /* public stuff */
#include "console_i.h" /* internal stuff */
#include <string.h>
#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
static __inline int
next(RlcData b, int i)
{ if ( ++i == b->history.size )
return 0;
return i;
}
static __inline int
prev(RlcData b, int i)
{ if ( --i < 0 )
return b->history.size-1;
return i;
}
void
rlc_init_history(rlc_console c, int size)
{ RlcData b = rlc_get_data(c);
int oldsize;
int i;
if ( b->history.lines )
{ b->history.lines = rlc_realloc(b->history.lines, sizeof(TCHAR *) * size);
oldsize = b->history.size;
} else
{ b->history.lines = rlc_malloc(sizeof(TCHAR *) * size);
oldsize = 0;
}
for(i=oldsize; i<size; i++)
b->history.lines[i] = NULL;
b->history.size = size;
b->history.current = -1;
}
void
rlc_add_history(rlc_console c, const TCHAR *line)
{ RlcData b = rlc_get_data(c);
if ( b->history.size )
{ int i = next(b, b->history.head);
size_t len = _tcslen(line);
while(*line && *line <= ' ') /* strip leading white-space */
line++;
len = _tcslen(line);
/* strip trailing white-space */
while ( len > 0 && line[len-1] <= ' ' )
len--;
if ( len == 0 )
{ b->history.current = -1;
return;
}
if ( b->history.lines[b->history.head] &&
_tcsncmp(b->history.lines[b->history.head], line, len) == 0 )
{ b->history.current = -1;
return; /* same as last line added */
}
if ( i == b->history.tail ) /* this one is lost */
b->history.tail = next(b, b->history.tail);
b->history.head = i;
b->history.current = -1;
if ( b->history.lines[i] )
b->history.lines[i] = rlc_realloc(b->history.lines[i],
(len+1)*sizeof(TCHAR));
else
b->history.lines[i] = rlc_malloc((len+1)*sizeof(TCHAR));
if ( b->history.lines[i] )
{ _tcsncpy(b->history.lines[i], line, len);
b->history.lines[i][len] = '\0';
}
}
}
int
rlc_at_head_history(RlcData b)
{ return b->history.current == -1 ? TRUE : FALSE;
}
const TCHAR *
rlc_bwd_history(RlcData b)
{ if ( b->history.size )
{ if ( b->history.current == -1 )
b->history.current = b->history.head;
else if ( b->history.current == b->history.tail )
return NULL;
else
b->history.current = prev(b, b->history.current);
return b->history.lines[b->history.current];
}
return NULL;
}
const TCHAR *
rlc_fwd_history(RlcData b)
{ if ( b->history.size && b->history.current != -1 )
{ const TCHAR *s;
b->history.current = next(b, b->history.current);
s = b->history.lines[b->history.current];
if ( b->history.current == b->history.head )
b->history.current = -1;
return s;
}
return NULL;
}

308
LGPL/swi_console/menu.c Normal file
View File

@ -0,0 +1,308 @@
/* $Id: menu.c,v 1.1 2008-03-27 00:41:33 vsc Exp $
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#include <windows.h>
#include <tchar.h>
#define _MAKE_DLL
#include "console.h"
#include "console_i.h"
#include "menu.h"
#ifndef EOS
#define EOS 0
#endif
#define streq(s,q) (_tcscmp((s), (q)) == 0)
static TCHAR **menuids;
static int nmenus;
static int nmenualloc;
static struct rl_item
{ UINT id;
const TCHAR *name;
} rl_items[] =
{ { IDM_EXIT, _T("&Exit") },
{ IDM_CUT, _T("&Cut") },
{ IDM_COPY, _T("&Copy") },
{ IDM_PASTE, _T("&Paste") },
{ IDM_BREAK, _T("&Interrupt") },
{ IDM_FONT, _T("&Font ...") },
{ 0, NULL }
};
static UINT
lookupMenuLabel(const TCHAR *label)
{ int i;
size_t llen;
struct rl_item *builtin;
for(builtin = rl_items; builtin->id; builtin++)
{ if ( streq(builtin->name, label) )
return builtin->id;
}
for(i=0; i<nmenus; i++)
{ if ( streq(menuids[i], label) )
return i + IDM_USER;
}
if ( nmenus + 1 > nmenualloc )
{ if ( nmenualloc )
{ nmenualloc *= 2;
menuids = rlc_realloc(menuids, nmenualloc*sizeof(TCHAR *));
} else
{ nmenualloc = 32;
menuids = rlc_malloc(nmenualloc*sizeof(TCHAR *));
}
}
llen = _tcslen(label);
menuids[nmenus] = rlc_malloc((llen+1)*sizeof(TCHAR));
_tcsncpy(menuids[nmenus], label, llen+1);
return nmenus++ + IDM_USER;
}
const TCHAR *
lookupMenuId(UINT id)
{ struct rl_item *builtin;
if ( id >= IDM_USER && (int)id - IDM_USER < nmenus )
return menuids[id-IDM_USER];
for(builtin = rl_items; builtin->id; builtin++)
{ if ( builtin->id == id )
return builtin->name;
}
return NULL;
}
int
insertMenu(HMENU in, const TCHAR *label, const TCHAR *before)
{ if ( !before )
{ if ( !label )
AppendMenu(in, MF_SEPARATOR, 0, NULL);
else
{ UINT id = lookupMenuLabel(label);
AppendMenu(in, MF_STRING, id, label);
}
} else
{ UINT bid = lookupMenuLabel(before);
MENUITEMINFO info;
memset(&info, 0, sizeof(info));
info.cbSize = sizeof(info);
info.fMask = MIIM_TYPE;
if ( label )
{ info.fType = MFT_STRING;
info.fMask |= MIIM_ID;
info.wID = lookupMenuLabel(label);
info.dwTypeData = (TCHAR *)label;
info.cch = (int)_tcslen(label);
} else
{ info.fType = MFT_SEPARATOR;
}
InsertMenuItem(in, bid, FALSE, &info);
}
return TRUE;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Find popup with given name.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static HMENU
findPopup(RlcData b, const TCHAR *name, int *pos)
{ HMENU mb = GetMenu(rlc_hwnd(b));
if ( mb )
{ int i;
MENUITEMINFO info;
memset(&info, 0, sizeof(info));
info.cbSize = sizeof(info);
info.fMask = MIIM_TYPE;
for(i=0; ; i++)
{ MENUITEMINFO info;
TCHAR nbuf[MAXLABELLEN];
memset(&info, 0, sizeof(info));
info.cbSize = sizeof(info);
info.fMask = MIIM_TYPE|MIIM_SUBMENU;
info.dwTypeData = nbuf;
info.cch = sizeof(nbuf);
if ( !GetMenuItemInfo(mb, i, TRUE, &info) )
return NULL;
if ( info.fType == MF_STRING )
{ if ( streq(name, nbuf) )
{ if ( pos )
*pos = i;
return info.hSubMenu;
}
}
}
}
return 0;
}
static void
append_builtin(HMENU menu, UINT id)
{ AppendMenu(menu, MF_STRING, id, lookupMenuId(id));
}
void
rlc_add_menu_bar(HWND cwin)
{ HMENU menu = CreateMenu();
HMENU file = CreatePopupMenu();
HMENU edit = CreatePopupMenu();
HMENU settings = CreatePopupMenu();
HMENU run = CreatePopupMenu();
append_builtin(file, IDM_EXIT);
/*append_builtin(edit, IDM_CUT);*/
append_builtin(edit, IDM_COPY);
append_builtin(edit, IDM_PASTE);
append_builtin(settings, IDM_FONT);
append_builtin(run, IDM_BREAK);
AppendMenu(menu, MF_POPUP, (UINT)file, _T("&File"));
AppendMenu(menu, MF_POPUP, (UINT)edit, _T("&Edit"));
AppendMenu(menu, MF_POPUP, (UINT)settings, _T("&Settings"));
AppendMenu(menu, MF_POPUP, (UINT)run, _T("&Run"));
SetMenu(cwin, menu);
}
/*******************************
* EXTERNAL *
*******************************/
#define MEN_MAGIC 0x6c4a58e0
typedef struct menu_data
{ intptr_t magic; /* safety */
const TCHAR *menu; /* menu to operate on */
const TCHAR *label; /* new label */
const TCHAR *before; /* add before this one */
int rc; /* result */
} menu_data;
void
rlc_menu_action(rlc_console c, menu_data *data)
{ RlcData b = rlc_get_data(c);
if ( !data || !data->magic == MEN_MAGIC )
return;
if ( data->menu ) /* rlc_insert_menu_item() */
{ HMENU popup;
if ( (popup = findPopup(b, data->menu, NULL)) )
data->rc = insertMenu(popup, data->label, data->before);
else
data->rc = FALSE;
} else /* insert_menu() */
{ HMENU mb;
HWND hwnd = rlc_hwnd(c);
if ( !(mb = GetMenu(hwnd)) )
{ data->rc = FALSE;
return;
}
if ( !findPopup(b, data->label, NULL) ) /* already there */
{ MENUITEMINFO info;
int bid = -1;
if ( data->before )
findPopup(b, data->before, &bid);
memset(&info, 0, sizeof(info));
info.cbSize = sizeof(info);
info.fMask = MIIM_TYPE|MIIM_SUBMENU;
info.fType = MFT_STRING;
info.hSubMenu = CreatePopupMenu();
info.dwTypeData = (TCHAR *)data->label;
info.cch = (int)_tcslen(data->label);
InsertMenuItem(mb, bid, TRUE, &info);
/* force redraw; not automatic! */
DrawMenuBar(hwnd);
}
data->rc = TRUE;
}
}
int
rlc_insert_menu(rlc_console c, const TCHAR *label, const TCHAR *before)
{ HWND hwnd = rlc_hwnd(c);
menu_data data;
data.magic = MEN_MAGIC;
data.menu = NULL;
data.label = label;
data.before = before;
SendMessage(hwnd, WM_RLC_MENU, 0, (LPARAM)&data);
return data.rc;
}
int
rlc_insert_menu_item(rlc_console c,
const TCHAR *menu, const TCHAR *label, const TCHAR *before)
{ HWND hwnd = rlc_hwnd(c);
menu_data data;
data.magic = MEN_MAGIC;
data.menu = menu;
data.label = label;
data.before = before;
SendMessage(hwnd, WM_RLC_MENU, 0, (LPARAM)&data);
return data.rc;
}

89
LGPL/swi_console/registry.c Normal file
View File

@ -0,0 +1,89 @@
/* $Id: registry.c,v 1.1 2008-03-27 00:41:33 vsc Exp $
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#include <windows.h>
#include "registry.h"
#define MAXKEYLEN 256
#define MAXKEYPATHLEN 1024
static TCHAR _rlc_regbase[MAXKEYPATHLEN] = TEXT("current_user/PrologConsole");
static HKEY
reg_open_key(const TCHAR *path, HKEY parent, REGSAM access)
{ TCHAR buf[MAXKEYLEN];
TCHAR *sep;
if ( *path )
return parent;
for(sep = path; *sep && *sep != '/' && *sep != '\\'; sep++)
;
strncpy(buf, path, sep-path);
if ( *sep )
sep++;
if ( strchr(sep, '/') || strchr(sep, '\\') ) /* there is more */
{ HKEY sub;
if ( RegOpenKeyEx(parent, buf, 0L, KEY_READ, &sub) != ERROR_SUCCESS )
return NULL;
return reg_open_key(sep, sub, access);
} else
{ HKEY sub;
if ( RegOpenKeyEx(parent, buf, 0L, KEY_READ, access) != ERROR_SUCCESS )
return NULL;
return sub;
}
}
HKEY
RegOpenKeyFromPath(const TCHAR *path, REGSAM access)
{ TCHAR buf[MAXKEYLEN];
TCHAR *sep;
HKEY root;
for(sep = path; *sep && *sep != '/' && *sep != '\\'; sep++)
;
strncpy(buf, path, sep-path);
if ( streq(buf, TEXT("classes_root")) )
root = HKEY_CLASSES_ROOT;
else if ( streq(buf, TEXT("current_user")) )
root = HKEY_CURRENT_USER;
else if ( streq(buf, TEXT("local_machine")) )
root = HKEY_LOCAL_MACHINE;
else if ( streq(buf, TEXT("users")) )
root = HKEY_USERS;
else
return NULL;
if ( *sep )
sep++;
return reg_open_key(sep, root, REGSAM);
}

2
Makefile.in
View File

@ -624,6 +624,7 @@ install_win32: startup
$(INSTALL_PROGRAM) -m 755 startup $(DESTDIR)$(YAPLIBDIR)/startup $(INSTALL_PROGRAM) -m 755 startup $(DESTDIR)$(YAPLIBDIR)/startup
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap mkdir -p $(DESTDIR)$(SHAREDIR)/Yap
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/swi
for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done
$(INSTALL) $(HEADERS) $(DESTDIR)$(INCLUDEDIR) $(INSTALL) $(HEADERS) $(DESTDIR)$(INCLUDEDIR)
for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done
@ -632,6 +633,7 @@ install_win32: startup
(cd library/matrix; make install) (cd library/matrix; make install)
(cd library/regex; make install) (cd library/regex; make install)
(cd library/system; make install) (cd library/system; make install)
(cd LGPL/swi_console; make install)
@INSTALL_MATLAB@ (cd library/matlab; make install) @INSTALL_MATLAB@ (cd library/matlab; make install)
(cd library/tries; make install) (cd library/tries; make install)
@ENABLE_CPLINT@ (cd cplint; make install) @ENABLE_CPLINT@ (cd cplint; make install)

4
configure vendored
View File

@ -16139,12 +16139,13 @@ mkdir -p LGPL/JPL/java/jpl/test
mkdir -p LGPL/JPL/src mkdir -p LGPL/JPL/src
mkdir -p LGPL/clp mkdir -p LGPL/clp
mkdir -p LGPL/chr mkdir -p LGPL/chr
mkdir -p LGPL/swi_console
mkdir -p GPL mkdir -p GPL
mkdir -p GPL/clpqr mkdir -p GPL/clpqr
mkdir -p GPL/http mkdir -p GPL/http
mkdir -p cplint mkdir -p cplint
ac_config_files="$ac_config_files Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile" ac_config_files="$ac_config_files Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile LGPL/swi_console/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile"
cat >confcache <<\_ACEOF cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure # This file is a shell script that caches the results of configure
@ -16718,6 +16719,7 @@ do
"GPL/clpqr/Makefile") CONFIG_FILES="$CONFIG_FILES GPL/clpqr/Makefile" ;; "GPL/clpqr/Makefile") CONFIG_FILES="$CONFIG_FILES GPL/clpqr/Makefile" ;;
"library/lammpi/Makefile") CONFIG_FILES="$CONFIG_FILES library/lammpi/Makefile" ;; "library/lammpi/Makefile") CONFIG_FILES="$CONFIG_FILES library/lammpi/Makefile" ;;
"library/tries/Makefile") CONFIG_FILES="$CONFIG_FILES library/tries/Makefile" ;; "library/tries/Makefile") CONFIG_FILES="$CONFIG_FILES library/tries/Makefile" ;;
"LGPL/swi_console/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/swi_console/Makefile" ;;
"LGPL/JPL/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/JPL/Makefile" ;; "LGPL/JPL/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/JPL/Makefile" ;;
"LGPL/JPL/src/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/JPL/src/Makefile" ;; "LGPL/JPL/src/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/JPL/src/Makefile" ;;
"LGPL/JPL/java/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/JPL/java/Makefile" ;; "LGPL/JPL/java/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/JPL/java/Makefile" ;;

3
configure.in
View File

@ -1401,12 +1401,13 @@ mkdir -p LGPL/JPL/java/jpl/test
mkdir -p LGPL/JPL/src mkdir -p LGPL/JPL/src
mkdir -p LGPL/clp mkdir -p LGPL/clp
mkdir -p LGPL/chr mkdir -p LGPL/chr
mkdir -p LGPL/swi_console
mkdir -p GPL mkdir -p GPL
mkdir -p GPL/clpqr mkdir -p GPL/clpqr
mkdir -p GPL/http mkdir -p GPL/http
mkdir -p cplint mkdir -p cplint
AC_OUTPUT(Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile) AC_OUTPUT(Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile LGPL/swi_console/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile)
make depend make depend

3
console/yap.c
View File

@ -545,7 +545,7 @@ parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
goto myddas_error; goto myddas_error;
} }
#endif #endif
return(BootMode); return BootMode;
} }
static char boot_file[256]; static char boot_file[256];
@ -589,7 +589,6 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap)
BootMode = parse_yap_arguments(argc,argv,iap); BootMode = parse_yap_arguments(argc,argv,iap);
if (BootMode == YAP_FULL_BOOT_FROM_PROLOG) { if (BootMode == YAP_FULL_BOOT_FROM_PROLOG) {
#if HAVE_STRNCAT #if HAVE_STRNCAT
strncpy(boot_file, PL_SRC_DIR, 256); strncpy(boot_file, PL_SRC_DIR, 256);
#else #else

55
misc/options.ini Normal file
View File

@ -0,0 +1,55 @@
[Settings]
NumFields=6
[Field 1]
Type=GroupBox
Left=0
Right=-1
Top=0
Bottom=-5
Text=Installation opions ...
[Field 2]
Type=Label
Left=10
Right=-10
Top=10
Bottom=25
Text=Normally .PL is used to indicate Prolog source files. If this extension is taken you may wish to use .PRO or .YAP as an alternative.
[Field 3]
Type=Label
Left=10
Right=120
Top=33
Bottom=45
Text=Extension for Prolog files
[Field 4]
Type=ComboBox
ListItems=pl|pro|yap
MaxLen=3
MinLen=1
ValidateText=A file name extension is 1, 2 or 3 characters
Left=120
Right=160
Top=30
Bottom=300
Flags=GROUP
[Field 5]
Type=Label
Left=10
Right=120
Top=48
Bottom=60
Text=Startmenu program group
[Field 6]
Type=Text
Left=120
Right=-10
Top=45
Bottom=60
Text=Program group...
State=YAP-Prolog

280
misc/yap.nsi Normal file
View File

@ -0,0 +1,280 @@
# YAP install-script (from SWI-Prolog)
!define TEMP1 $R0 ; Temp variable
!define EXT $3 ; Filename extension for Prolog sources
!define CWD $4 ; Working directory for startmenu shortcut
!define GRP $5 ; Startmenu group
!define SHCTX $6 ; Shell context (current/all)
!define ARCH $7 ; Architecture (x86, ia64 or amd64)
!ifdef WIN64
!define REGKEY SOFTWARE\YAP\Prolog64
!else
!define REGKEY SOFTWARE\YAP\Prolog
!endif
RequestExecutionLevel admin
SetCompressor bzip2
MiscButtonText "<back" "next>" "abort" "finished"
# Preload files that are needed by the installer itself
ReserveFile "${NSISDIR}\Plugins\UserInfo.dll"
ReserveFile "${NSISDIR}\Plugins\InstallOptions.dll"
ReserveFile "options.ini"
InstallDir $PROGRAMFILES\Yap
InstallDirRegKey HKLM ${REGKEY} "home"
ComponentText "This will install YAP on your computer."
DirText "This program will install YAP on your computer.\
Choose a directory"
LicenseData c:\Yap\share\docs\Artistic
LicenseText "YAP is governed by the Artistic License,\
but includes code under the GPL and LGPL."
InstType "Typical (all except debug symbols)" # 1
InstType "Minimal (no graphics)" # 2
InstType "Full" # 3
Page license
Page directory
Page custom SetCustom "" ": Installation options"
Page instfiles
Section "Base system (required)"
SectionIn RO # do not allow to delete this
Delete $INSTDIR\bin\*.pdb
SetOutPath $INSTDIR\bin
File c:\Yap\bin\yap.exe
File c:\Yap\bin\yap.dll
SetOutPath $INSTDIR\bin
; SYSTEM STUFF
File c:\Yap\lib\Yap\matrix.dll
File c:\Yap\lib\Yap\plterm.dll
File c:\Yap\lib\Yap\random.dll
File c:\Yap\lib\Yap\regcomp.dll
File c:\Yap\lib\Yap\regerror.dll
File c:\Yap\lib\Yap\regexec.dll
File c:\Yap\lib\Yap\regexp.dll
File c:\Yap\lib\Yap\regfree.dll
File c:\Yap\lib\Yap\sys.dll
File c:\Yap\lib\Yap\yap_tries.dll
SetOutPath $INSTDIR\lib
; SYSTEM STUFF
File c:\Yap\lib\Yap\libWYap.a
SetOutPath $INSTDIR\lib
; SYSTEM STUFF
File c:\Yap\lib\Yap\startup
SetOutPath $INSTDIR\share
; SYSTEM STUFF
File /r c:\Yap\share\Yap\*
SetOutPath $INSTDIR\docs
File c:\Yap\share\docs\yap.html
File c:\Yap\share\docs\yap.pdf
File c:\Yap\share\docs\Artistic
File c:\Yap\share\docs\README.TXT
File c:\Yap\share\docs\COPYING.TXT
WriteRegStr HKLM ${REGKEY} "home" "$INSTDIR"
WriteRegStr HKLM ${REGKEY} "startup" "$INSTDIR\lib\startup"
WriteRegStr HKLM ${REGKEY} "library" "$INSTDIR\share"
; Write uninstaller
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\YAP" "DisplayName" "YAP (remove only)"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\YAP" "UninstallString" '"$INSTDIR\uninstall.exe"'
WriteUninstaller "uninstall.exe"
SectionEnd
Section "Start Menu shortcuts"
SectionIn 1 2 3
SetOutPath ${CWD}
CreateDirectory "$SMPROGRAMS\${GRP}"
CreateShortCut "$SMPROGRAMS\${GRP}\Prolog.lnk" \
"$INSTDIR\bin\yap.exe" \
"--win_app" \
"$INSTDIR\bin\yap.exe" \
0
SetOutPath $INSTDIR
CreateShortCut "$SMPROGRAMS\${GRP}\Readme.lnk" \
"$INSTDIR\docs\README.txt" "" \
"$INSTDIR\docs\README.txt" 0 \
"SW_SHOWNORMAL" "" "View readme"
CreateShortCut "$SMPROGRAMS\${GRP}\Manual Html.lnk" \
"$INSTDIR\docs\yap.html" "" \
"$INSTDIR\docs\yap.html" 0 \
"SW_SHOWNORMAL" "" "View readme"
CreateShortCut "$SMPROGRAMS\${GRP}\Manual PDF.lnk" \
"$INSTDIR\docs\yap.pdf" "" \
"$INSTDIR\docs\yap.pdf" 0 \
"SW_SHOWNORMAL" "" "View readme"
CreateShortCut "$SMPROGRAMS\${GRP}\Uninstall.lnk" \
"$INSTDIR\uninstall.exe" \
"" \
"$INSTDIR\uninstall.exe" \
0
WriteRegStr HKLM ${REGKEY} group ${GRP}
WriteRegStr HKLM ${REGKEY} cwd ${CWD}
WriteRegStr HKLM ${REGKEY} context ${SHCTX}
SectionEnd
################################################################
# The uninstaller
################################################################
UninstallText "This will uninstall YAP. Hit Uninstall to continue."
Section "Uninstall"
ReadRegStr ${EXT} HKLM Software\YAP\Prolog fileExtension
ReadRegStr ${GRP} HKLM Software\YAP\Prolog group
ReadRegStr ${SHCTX} HKLM Software\YAP\Prolog context
StrCmp ${SHCTX} "all" 0 +2
SetShellVarContext all
MessageBox MB_YESNO "Delete the following components?$\r$\n \
Install dir: $INSTDIR$\r$\n \
Extension: ${EXT}$\r$\n \
Program Group ${GRP}" \
IDNO Done
StrCmp ".${EXT}" "" NoExt
ReadRegStr $1 HKCR .${EXT} ""
StrCmp $1 "PrologFile" 0 NoOwn ; only do this if we own it
ReadRegStr $1 HKCR .${EXT} "backup_val"
StrCmp $1 "" 0 RestoreBackup ; if backup == "" then delete the whole key
DeleteRegKey HKCR .${EXT}
Goto NoOwn
RestoreBackup:
WriteRegStr HKCR .${EXT} "" $1
DeleteRegValue HKCR .${EXT} "backup_val"
NoOwn:
NoExt:
StrCmp "${GRP}" "" NoGrp
MessageBox MB_OK "Deleting $SMPROGRAMS\${GRP}"
RMDir /r "$SMPROGRAMS\${GRP}"
NoGrp:
IfFileExists "$INSTDIR\bin\yap.exe" 0 NoDir
RMDir /r "$INSTDIR"
goto Done
NoDir:
MessageBox MB_OK "Folder $INSTDIR doesn't seem to contain Prolog"
Done:
DeleteRegKey HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\YAP"
DeleteRegKey HKLM ${REGKEY}
SectionEnd
################################################################
# FUNCTIONS
################################################################
Function .onInit
;Extract InstallOptions files
;$PLUGINSDIR will automatically be removed when the installer closes
InitPluginsDir
File /oname=$PLUGINSDIR\options.ini "options.ini"
FunctionEnd
################################################################
# Handle customisation; Settings are maintained in
#
# HKLM ${REGKEY}
#
# Using the following mapping:
#
# ${EXT} fileExtension
################################################################
Function SetCustom
# Basic system info
Call UserInfo
# Filename extension
ReadRegStr ${EXT} HKLM ${REGKEY} fileExtension
StrCmp ${EXT} "" 0 HasExt
StrCpy ${EXT} "pl"
HasExt:
WriteINIStr $PLUGINSDIR\options.ini "Field 4" "State" ${EXT}
# Startmenu program group
ReadRegStr ${GRP} HKLM ${REGKEY} group
StrCmp ${GRP} "" 0 HasGroup
StrCpy ${GRP} "YAP"
HasGroup:
WriteINIStr $PLUGINSDIR\options.ini "Field 6" "State" ${GRP}
# Start the dialog
Push ${TEMP1}
InstallOptions::dialog "$PLUGINSDIR\options.ini"
Pop ${TEMP1}
Pop ${TEMP1}
# Get the results
ReadINIStr ${EXT} $PLUGINSDIR\options.ini "Field 4" "State"
ReadINIStr ${GRP} $PLUGINSDIR\options.ini "Field 6" "State"
FunctionEnd
Function UserInfo
ClearErrors
UserInfo::GetName
IfErrors Win9x
Pop $0
UserInfo::GetAccountType
Pop $1
StrCmp $1 "Admin" 0 +4
SetShellVarContext all
StrCpy ${SHCTX} "all"
Goto done
StrCmp $1 "Power" 0 +3
StrCpy ${SHCTX} "all"
Goto done
StrCmp $1 "User" 0 +3
StrCpy ${SHCTX} "current"
Goto done
StrCmp $1 "Guest" 0 +3
StrCpy ${SHCTX} "current"
Goto done
StrCpy ${SHCTX} "current" # Unkown accounttype
Goto done
Win9x:
StrCpy ${SHCTX} "current"
Goto end
done:
StrCmp ${SHCTX} "all" 0 +2
SetShellVarContext all
end:
FunctionEnd
Function .onInstSuccess
MessageBox MB_YESNO "Installation complete. View readme?" IDNO NoReadme
ExecShell "open" "$INSTDIR\docs\README.TXT"
NoReadme:
FunctionEnd
Function .onInstFailed
MessageBox MB_OK "Installation failed.$\r$\n\
If you cannot resolve the issue or it is a bug in the$\r$\n\
installer, please contact yap-users@sf.net"
FunctionEnd
outfile "yap-5.3.1-installer.exe"

4
pl/messages.yap
View File

@ -11,7 +11,7 @@
* File: utilities for displaying messages in YAP. * * File: utilities for displaying messages in YAP. *
* comments: error messages for YAP * * comments: error messages for YAP *
* * * *
* Last rev: $Date: 2008-03-25 01:04:27 $,$Author: pmoura $ * * Last rev: $Date: 2008-03-27 00:41:33 $,$Author: vsc $ *
* * * *
* * * *
*************************************************************************/ *************************************************************************/
@ -153,6 +153,8 @@ system_message(error(existence_error(procedure,P), context(Call,Parent))) --> !,
[ 'EXISTENCE ERROR- procedure ~w is undefined, called from context ~w~n Goal was ~w' - [P,Parent,Call] ]. [ 'EXISTENCE ERROR- procedure ~w is undefined, called from context ~w~n Goal was ~w' - [P,Parent,Call] ].
system_message(error(existence_error(stream,Stream), Where)) --> system_message(error(existence_error(stream,Stream), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not an open stream' - [Where,Stream] ]. [ 'EXISTENCE ERROR- ~w: ~w not an open stream' - [Where,Stream] ].
system_message(error(existence_error(key,Key), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not an existing key' - [Where,Key] ].
system_message(error(existence_error(thread,Thread), Where)) --> system_message(error(existence_error(thread,Thread), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not a running thread' - [Where,Thread] ]. [ 'EXISTENCE ERROR- ~w: ~w not a running thread' - [Where,Thread] ].
system_message(error(existence_error(Name,F), W)) --> system_message(error(existence_error(Name,F), W)) -->