From 07f67898673072743c348ed9df7fcf95354f3e65 Mon Sep 17 00:00:00 2001 From: ibs Date: Mon, 19 Nov 2012 16:35:34 +0400 Subject: [PATCH] The scripts prepare a WOK "binary" directory from compiled WOK sources .bat arguments: %1 - vc version; %2 - architecture; %3 - debug or release; %4 - related "binary" directory name (package - by default) The nix script prepares a WOK "binary" directory from compiled WOK sources .sh arguments: $1- debug or release; $2 - compiler name; $3 - related binary directory name (package - by default) --- building_WOK_with_vc.txt | 39 + collect_binary.bat | 496 ++++++ collect_binary.sh | 381 +++++ src/WOKTclLib/OS.tcl | 9 +- src/WOKTclLib/osutils.tcl | 13 + src/WOKTclLib/template.mam | 21 - src/WOKTclLib/template.mamx | 10 - src/WOKTclLib/template.vc10 | 126 -- src/WOKTclLib/template.vc10_64 | 126 -- src/WOKTclLib/template.vc10x | 124 -- src/WOKTclLib/template.vc10x_64 | 124 -- src/WOKTclLib/template.vc6 | 94 -- src/WOKTclLib/template.vc6x | 94 -- src/WOKTclLib/template.vc7 | 156 -- src/WOKTclLib/template.vc7x | 150 -- src/WOKTclLib/template.vc8 | 220 --- src/WOKTclLib/template.vc8_64 | 221 --- src/WOKTclLib/template.vc8x | 214 --- src/WOKTclLib/template.vc8x_64 | 216 --- src/WOKTclLib/template.vc9 | 216 --- src/WOKTclLib/template.vc9_64 | 214 --- src/WOKTclLib/template.vc9x | 207 --- src/WOKTclLib/template.vc9x_64 | 209 --- src/WOKTclLib/templates/env.sh | 2 +- src/WOKsite/.emacs | 11 + src/WOKsite/public_el/abv-keys.el | 55 + src/WOKsite/public_el/brief.el | 510 ++++++ src/WOKsite/public_el/buffer-navig.el | 109 ++ src/WOKsite/public_el/c++-mode.el | 494 ++++++ src/WOKsite/public_el/cdl-mode.el | 610 +++++++ src/WOKsite/public_el/class-info.el | 331 ++++ src/WOKsite/public_el/csf-c++-mode.el | 251 +++ src/WOKsite/public_el/csf-cdl-mode.el | 30 + src/WOKsite/public_el/csf-tools.el | 70 + src/WOKsite/public_el/eap-pc-mode.el | 368 +++++ src/WOKsite/public_el/edl-mode.el | 87 + src/WOKsite/public_el/faces.el | 103 ++ src/WOKsite/public_el/inheritance.el | 328 ++++ src/WOKsite/public_el/method-search.el | 506 ++++++ src/WOKsite/public_el/my_csf.el | 154 ++ src/WOKsite/public_el/occ-c++-mode.el | 82 + src/WOKsite/public_el/rename.el | 352 ++++ src/WOKsite/public_el/shared.el | 875 ++++++++++ src/WOKsite/public_el/source-browse.el | 497 ++++++ src/WOKsite/public_el/tcl-mode.el | 2045 ++++++++++++++++++++++++ src/WOKsite/public_el/tclsh.el | 45 + src/WOKsite/public_el/theme-dark.el | 115 ++ src/WOKsite/public_el/theme-kgv.el | 88 + src/WOKsite/public_el/tree.el | 686 ++++++++ src/WOKsite/public_el/type-search.el | 520 ++++++ src/WOKsite/public_el/wok-view.el | 70 + src/WOKsite/wok_emacs.bat | 11 + src/WOKsite/wok_emacs.sh | 13 + 53 files changed, 10353 insertions(+), 2745 deletions(-) create mode 100644 building_WOK_with_vc.txt create mode 100644 collect_binary.bat create mode 100644 collect_binary.sh delete mode 100755 src/WOKTclLib/template.mam delete mode 100755 src/WOKTclLib/template.mamx delete mode 100644 src/WOKTclLib/template.vc10 delete mode 100644 src/WOKTclLib/template.vc10_64 delete mode 100644 src/WOKTclLib/template.vc10x delete mode 100644 src/WOKTclLib/template.vc10x_64 delete mode 100755 src/WOKTclLib/template.vc6 delete mode 100755 src/WOKTclLib/template.vc6x delete mode 100755 src/WOKTclLib/template.vc7 delete mode 100755 src/WOKTclLib/template.vc7x delete mode 100755 src/WOKTclLib/template.vc8 delete mode 100755 src/WOKTclLib/template.vc8_64 delete mode 100755 src/WOKTclLib/template.vc8x delete mode 100755 src/WOKTclLib/template.vc8x_64 delete mode 100755 src/WOKTclLib/template.vc9 delete mode 100755 src/WOKTclLib/template.vc9_64 delete mode 100755 src/WOKTclLib/template.vc9x delete mode 100755 src/WOKTclLib/template.vc9x_64 create mode 100644 src/WOKsite/.emacs create mode 100644 src/WOKsite/public_el/abv-keys.el create mode 100644 src/WOKsite/public_el/brief.el create mode 100644 src/WOKsite/public_el/buffer-navig.el create mode 100644 src/WOKsite/public_el/c++-mode.el create mode 100644 src/WOKsite/public_el/cdl-mode.el create mode 100644 src/WOKsite/public_el/class-info.el create mode 100644 src/WOKsite/public_el/csf-c++-mode.el create mode 100644 src/WOKsite/public_el/csf-cdl-mode.el create mode 100644 src/WOKsite/public_el/csf-tools.el create mode 100644 src/WOKsite/public_el/eap-pc-mode.el create mode 100644 src/WOKsite/public_el/edl-mode.el create mode 100644 src/WOKsite/public_el/faces.el create mode 100644 src/WOKsite/public_el/inheritance.el create mode 100644 src/WOKsite/public_el/method-search.el create mode 100644 src/WOKsite/public_el/my_csf.el create mode 100644 src/WOKsite/public_el/occ-c++-mode.el create mode 100644 src/WOKsite/public_el/rename.el create mode 100644 src/WOKsite/public_el/shared.el create mode 100644 src/WOKsite/public_el/source-browse.el create mode 100644 src/WOKsite/public_el/tcl-mode.el create mode 100644 src/WOKsite/public_el/tclsh.el create mode 100644 src/WOKsite/public_el/theme-dark.el create mode 100644 src/WOKsite/public_el/theme-kgv.el create mode 100644 src/WOKsite/public_el/tree.el create mode 100644 src/WOKsite/public_el/type-search.el create mode 100644 src/WOKsite/public_el/wok-view.el create mode 100644 src/WOKsite/wok_emacs.bat create mode 100644 src/WOKsite/wok_emacs.sh diff --git a/building_WOK_with_vc.txt b/building_WOK_with_vc.txt new file mode 100644 index 0000000..5d9b5e3 --- /dev/null +++ b/building_WOK_with_vc.txt @@ -0,0 +1,39 @@ +Building WOK with Visual Studio + +1. Clone the WOK git repository from the server. + +2. Create the occt-wok WOK workbench setting its Home to the directory containing WOK git repository. +For example, assuming that WOK repository has been created into d:/occt-wok and OCCT workbench is occt + LOC:dev> wcreate occt-wok –DHome=D:/occt-wok -f occt + +3. Use command wokcd, Go to the created workbench: + LOC:dev> wokcd occt-wok + +4. For the success wgenproj completion, before the execution, make sure that inc folder exists in the WOK root directory + +5. Using the wgenproj command with –IDE= (for example, vc8|vc9|vc10) in the WOK workbench generate visual studio project files: + LOC:dev:occt-wok> wgenproj –IDE=vc9 + + +6. When the generation process finished, start the msvc.bat placed into the WOK root directory, and build the solution. + +7. To create binary WOK directory, start the collect_binary.bat batch file with arguments: + + collect_binary.bat + + where arguments are: + - vc8, vc9 or vc10 + - win32 or win64 + - Release or Debug + - by default the one is package are located into WOK root directory. + + For example, + collect_binary.bat vc9 win32 release wokPackage + + or start collect_binary.bat without arguments, to use by default arguments, that are: + vc version is defined by user into wok_depsgui + win bitness is defined by user into wok_depsgui + build type is release + install dir name is package + +8. Finally, copy from used WOK root directory the 3rdparty directory to the wokPackage directory. \ No newline at end of file diff --git a/collect_binary.bat b/collect_binary.bat new file mode 100644 index 0000000..131a661 --- /dev/null +++ b/collect_binary.bat @@ -0,0 +1,496 @@ +@echo off +Setlocal EnableDelayedExpansion + +set COPYCMD=/Y + +rem %1 - vcver +rem %2 - arch +rem %3 - debug&release +rem %4 - related package name + +set "cmdArg1=%1" +set "cmdArg2=%2" +set "cmdArg3=%3" +set "cmdArg4=%4" + +set "installPath=package" + +set configFile=collect_binary.cfg +if exist %configFile% ( + for /f "delims=" %%x in (%configFile%) do (set "%%x") +) + +rem if command line is empty and config file is not exist +if "%cmdArg1%" == "" goto :eofWithEcho +if "%cmdArg2%" == "" goto :eofWithEcho +if "%cmdArg3%" == "" goto :eofWithEcho + +goto :GoOn + +:eofWithEcho +echo Some arguments are empty. Please try again. For example, +echo %0 vc10 64 release installDirRelatedPath +goto :eof + +:GoOn + +echo. +echo "args are: %cmdArg1% %cmdArg2% %cmdArg3% %cmdArg4% +echo. + +if not "%cmdArg4%" == "" ( + set "installPath=%cmdArg4%" +) + +rem Setup environment +call "%~dp0env.bat" %cmdArg1% %cmdArg2% %cmdArg3% + +if "%ARCH%" == "32" ( + set "xBit=x86" +) else ( + if "%VCVER%" == "vc10" ( + set "xBit=x64" + ) else if "%VCVER%" == "vc9" ( + set "xBit=amd64" + ) +) + +set "TCL_LIB_PATH=" +for %%a IN (%searchLibString%) DO ( + if not "%%a" == "" ( + set "line=%%a" + if not !line!==!line:Tcl=! ( + set "TCL_LIB_PATH=!line!" + goto exitfor + ) + + if not !line!==!line:TCL=! ( + set "TCL_LIB_PATH=!line!" + goto exitfor + ) + + if not !line!==!line:tcl=! ( + set "TCL_LIB_PATH=!line!" + goto exitfor + ) + ) +) +:exitfor + +if "%VCVER%" == "vc8" ( + set "VSDir=%VS80COMNTOOLS%" + set "msvcXNum=80" + +) else if "%VCVER%" == "vc9" ( + set "VSDir=%VS90COMNTOOLS%" + set "msvcXNum=90" + +) else if "%VCVER%" == "vc10" ( + set "VSDir=%VS100COMNTOOLS%" + set "msvcXNum=100" + +) else ( + echo Error: wrong VS identifier + exit /B +) + +set "doNotCopyForeignFileList=" + +if exist "%CASROOT%\win%ARCH%\%VCVER%\bin%CASDEB%" ( + set "preOCCDLLPath=win%ARCH%\%VCVER%\bin%CASDEB%" +) else if exist "%CASROOT%\wnt\bin%CASDEB%" ( + echo. + echo "%CASROOT%\wnt\bin%CASDEB% doesn't exist." + echo "%CASROOT%\wnt\bin%CASDEB% folder has been chosen" + echo. + set "preOCCDLLPath=wnt\bin%CASDEB%" +) else ( + echo. + echo "OCC dll folders (%CASROOT%\win%ARCH%\%VCVER%\bin%CASDEB% and %CASROOT%\wnt\bin%CASDEB%) don't exist" + echo "Please enter the correct paths" + echo. + goto :eof +) + +xcopy "%CASROOT%\%preOCCDLLPath%\TKAdvTools.dll" "%installPath%\lib\wnt\" +if not %errorlevel%. == 0. (set "doNotCopyForeignFileList=%doNotCopyForeignFileList%;TKAdvTools.dll") + +xcopy "%CASROOT%\%preOCCDLLPath%\TKernel.dll" "%installPath%\lib\wnt\" +if not %errorlevel%. == 0. (set "doNotCopyForeignFileList=%doNotCopyForeignFileList%;TKernel.dll") + +xcopy "%VSDir%..\..\VC\redist\%xBit%\Microsoft.%VCVER%0.CRT\msvcp%msvcXNum%.dll" "%installPath%\lib\wnt\" +if not %errorlevel%. == 0. (set "doNotCopyForeignFileList=%doNotCopyForeignFileList%;msvcp%msvcXNum%.dll") + +xcopy "%VSDir%..\..\VC\redist\%xBit%\Microsoft.%VCVER%0.CRT\msvcr%msvcXNum%.dll" "%installPath%\lib\wnt\" +if not %errorlevel%. == 0. (set "doNotCopyForeignFileList=%doNotCopyForeignFileList%;msvcr%msvcXNum%.dll") + +if exist "%~dp0win%ARCH%\%VCVER%\bin%CASDEB%" ( + set "preDLLPath=win%ARCH%\%VCVER%\bin%CASDEB%" +) else if exist "%~dp0wnt\bin%CASDEB%" ( + echo. + echo "%~dp0win%ARCH%\%VCVER%\bin%CASDEB% doesn't exist." + echo "%~dp0wnt\bin%CASDEB% folder has been chosen" + echo. + set "preDLLPath=wnt\bin%CASDEB%" +) else ( + echo. + echo "WOK dll folders (%~dp0win%ARCH%\%VCVER%\bin%CASDEB% ; %~dp0wnt\bin%CASDEB%) don't exist." + echo "Please enter the correct paths" + echo. + goto :eof +) + +xcopy "%~dp0%preDLLPath%\*.dll" "%installPath%\lib\wnt\" +if not %errorlevel%. == 0. (set "doNotCopyForeignFileList=bin *.dll") + +mkdir "%installPath%\wok_entities\" + +mkdir "%installPath%\3rdparty\" +mkdir "%installPath%\3rdparty\win32\" +mkdir "%installPath%\3rdparty\win32\codegen\" +mkdir "%installPath%\3rdparty\win32\Emacs\" +mkdir "%installPath%\3rdparty\win32\tcltk\" +mkdir "%installPath%\3rdparty\win32\utils\" + + +xcopy "src\WOKsite\tclshrc.tcl" "%installPath%\home\" +xcopy "src\WOKsite\.emacs" "%installPath%\home\" +xcopy "src\WOKsite\.emacs" "%installPath%\home\" + +xcopy "src\WOKsite\public_el" "%installPath%\site\public_el\" /S +xcopy "custom.bat" "%installPath%\site\" + +xcopy "src\CPPJini\CPPJini_General.edl" "%installPath%\lib\" +xcopy "src\CPPJini\CPPJini_Template.edl" "%installPath%\lib\" + +xcopy "src\WOKOBJS\OBJS.edl" "%installPath%\lib\" +xcopy "src\WOKOBJS\OBJSSCHEMA.edl" "%installPath%\lib\" + +xcopy "src\WOKLibs\pkgIndex.tcl" "%installPath%\lib\" + +xcopy "src\TCPPExt\TCPPExt_MethodTemplate.edl" "%installPath%\lib\" + +xcopy "src\WOKDeliv\WOKDeliv_DelivExecSource.tcl" "%installPath%\lib\" +xcopy "src\WOKDeliv\WOKDeliv_FRONTALSCRIPT.edl" "%installPath%\lib\" +xcopy "src\WOKDeliv\WOKDeliv_LDSCRIPT.edl" "%installPath%\lib\" + +xcopy "src\CSFDBSchema\CSFDBSchema_Template.edl" "%installPath%\lib\" + +xcopy "src\WOKUtils\EDL.edl" "%installPath%\lib\" + +xcopy "src\CPPIntExt\Engine_Template.edl" "%installPath%\lib\" +xcopy "src\CPPIntExt\Interface_Template.edl" "%installPath%\lib\" + +xcopy "src\WOKTclTools\ENV.edl" "%installPath%\lib\" + +xcopy "src\WOKEntityDef\FILENAME.edl" "%installPath%\lib\" + +xcopy "src\CPPExt\CPPExt_Standard.edl" "%installPath%\lib\" +xcopy "src\CPPExt\CPPExt_Template.edl" "%installPath%\lib\" +xcopy "src\CPPExt\CPPExt_TemplateCSFDB.edl" "%installPath%\lib\" +xcopy "src\CPPExt\CPPExt_TemplateOBJS.edl" "%installPath%\lib\" +xcopy "src\CPPExt\CPPExt_TemplateOBJY.edl" "%installPath%\lib\" + + +xcopy "src\WOKOrbix\IDLFRONT.edl" "%installPath%\lib\" +xcopy "src\WOKOrbix\ORBIX.edl" "%installPath%\lib\" +xcopy "src\WOKOrbix\WOKOrbix_ClientObjects.tcl" "%installPath%\lib\" +xcopy "src\WOKOrbix\WOKOrbix_ServerObjects.tcl" "%installPath%\lib\" + +xcopy "src\WOKEntityDef\WOKEntity.edl" "%installPath%\lib\" +xcopy "src\WOKEntityDef\WOKEntity_Factory.edl" "%installPath%\lib\" +xcopy "src\WOKEntityDef\WOKEntity_Parcel.edl" "%installPath%\lib\" +xcopy "src\WOKEntityDef\WOKEntity_ParcelUnit.edl" "%installPath%\lib\" +xcopy "src\WOKEntityDef\WOKEntity_Unit.edl" "%installPath%\lib\" +xcopy "src\WOKEntityDef\WOKEntity_UnitTypes.edl" "%installPath%\lib\" +xcopy "src\WOKEntityDef\WOKEntity_Warehouse.edl" "%installPath%\lib\" +xcopy "src\WOKEntityDef\WOKEntity_Workbench.edl" "%installPath%\lib\" +xcopy "src\WOKEntityDef\WOKEntity_WorkbenchUnit.edl" "%installPath%\lib\" +xcopy "src\WOKEntityDef\WOKEntity_Workshop.edl" "%installPath%\lib\" + +xcopy "src\WOKStep\WOKStep_frontal.tcl" "%installPath%\lib\" +xcopy "src\WOKStep\WOKStep_JavaCompile.tcl" "%installPath%\lib\" +xcopy "src\WOKStep\WOKStep_JavaHeader.tcl" "%installPath%\lib\" +xcopy "src\WOKStep\WOKStep_LibRename.tcl" "%installPath%\lib\" +xcopy "src\WOKStep\WOKStep_ManifestEmbed.tcl" "%installPath%\lib\" +xcopy "src\WOKStep\WOKStep_TclLibIdep.tcl" "%installPath%\lib\" + + +xcopy "src\WOKStepsDef\FRONTAL.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_ccl.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_client.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_client_wnt.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_Del.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_delivery.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_documentation.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_engine.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_engine_wnt.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_executable.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_executable_wnt.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_frontal.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_idl.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_interface.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_interface_wnt.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_jini.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_nocdlpack.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_nocdlpack_wnt.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_package.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_package_wnt.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_resource.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_schema.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_schema_DFLT.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_schema_OBJS.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_schema_OBJY.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_server.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_toolkit.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKSteps_toolkit_wnt.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKStepsDeliv.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKStepsDFLT.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKStepsOBJS.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKStepsOBJY.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKStepsOrbix.edl" "%installPath%\lib\" +xcopy "src\WOKStepsDef\WOKStepsStep.edl" "%installPath%\lib\" + +xcopy "src\WOKsite\wok.csh" "%installPath%\site\" +xcopy "src\WOKsite\wokinit.csh" "%installPath%\site\" +xcopy "src\WOKsite\DEFAULT.edl" "%installPath%\site\" +xcopy "src\WOKsite\WOKSESSION.edl" "%installPath%\site\" +xcopy "src\WOKsite\CreateFactory.tcl" "%installPath%\site\" +xcopy "src\WOKsite\interp.tcl" "%installPath%\site\" +xcopy "src\WOKsite\tclshrc.tcl" "%installPath%\site\" +xcopy "src\WOKsite\wok_deps.tcl" "%installPath%\site\" +xcopy "src\WOKsite\wok_depsgui.tcl" "%installPath%\site\" +xcopy "src\WOKsite\wok_tclshrc.tcl" "%installPath%\site\" +xcopy "src\WOKsite\wok.bat" "%installPath%\site\" +xcopy "src\WOKsite\wok_confgui.bat" "%installPath%\site\" +xcopy "src\WOKsite\wok_emacs.bat" "%installPath%\site\" +xcopy "src\WOKsite\wok_env.bat" "%installPath%\site\" +xcopy "src\WOKsite\wok_init.bat" "%installPath%\site\" +xcopy "src\WOKsite\wok_tclsh.bat" "%installPath%\site\" +xcopy "src\WOKsite\wokinit.bat" "%installPath%\site\" + +xcopy "src\CPPClient\CPPClient_General.edl" "%installPath%\lib\" +xcopy "src\CPPClient\CPPClient_Template.edl" "%installPath%\lib\" + + +rem from WOKBuilderDef to lib folder +xcopy "src\WOKBuilderDef\ARX.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CDLTranslate.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CMPLRS.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CMPLRS_AIX.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CMPLRS_BSD.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CMPLRS_HP.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CMPLRS_LIN.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CMPLRS_MAC.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CMPLRS_SIL.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CMPLRS_SUN.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CMPLRS_WNT.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CODEGEN.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\COMMAND.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CPP.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CPPCLIENT.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CPPENG.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CPPINT.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CPPJINI.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSF.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSF_AIX.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSF_AO1.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSF_BSD.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSF_HP.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSF_LIN.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSF_MAC.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSF_SIL.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSF_SUN.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSF_WNT.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\CSFDBSCHEMA.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\JAVA.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\LD.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\LDAR.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\LDEXE.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\LDSHR.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\LIB.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\LINK.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\LINKSHR.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\STUBS.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\TCPP.edl" "%installPath%\lib\" +xcopy "src\WOKBuilderDef\USECONFIG.edl" "%installPath%\lib\" + +rem WOKTclLib to lib +xcopy "src\WOKTclLib\templates" "%installPath%\lib\templates" /i +xcopy "src\WOKTclLib\abstract.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\admin.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\arb.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\back.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\Browser.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\browser.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\BrowserOMT.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\BrowserSearch.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\bycol.xbm" "%installPath%\lib\" +xcopy "src\WOKTclLib\bylast.xbm" "%installPath%\lib\" +xcopy "src\WOKTclLib\bylong.xbm" "%installPath%\lib\" +xcopy "src\WOKTclLib\byrow.xbm" "%installPath%\lib\" +xcopy "src\WOKTclLib\caution.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\cback.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\ccl.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\ccl_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\cell.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\cfrwd.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\client.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\client_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\config.h" "%installPath%\lib\" +xcopy "src\WOKTclLib\create.xpm" "%installPath%\site\" +xcopy "src\WOKTclLib\danger.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\delete.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\delivery.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\delivery_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\dep.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\documentation.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\documentation_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\engine.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\engine_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\envir.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\envir_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\executable.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\executable_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\factory.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\factory_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\file.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\FILES" "%installPath%\lib\" +xcopy "src\WOKTclLib\frontal.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\frontal_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\gettable.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\idl.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\idl_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\interface.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\interface_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\jini.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\jini_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\journal.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\MkBuild.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\news_cpwb.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\nocdlpack.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\nocdlpack_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\notes.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\OCCTDocumentation.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\OCCTGetVersion.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\opencascade.gif" "%installPath%\lib\" +xcopy "src\WOKTclLib\OS.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\osutils.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\package.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\package_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\params.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\parcel.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\parcel_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\patch.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\patches.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\path.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\persistent.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\pqueue.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\prepare.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\private.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\queue.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\README" "%installPath%\lib\" +xcopy "src\WOKTclLib\reposit.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\resource.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\resource_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\rotate.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\scheck.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\schema.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\schema_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\see.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\see_closed.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\server.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\server_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\source.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\storable.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\tclx.nt" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.mam" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.mamx" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.min" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.minx" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc10" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc10_64" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc10x" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc10x_64" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc6" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc6x" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc7" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc7x" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc8" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc8_64" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc8x" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc8x_64" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc9" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc9_64" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc9x" "%installPath%\lib\" +xcopy "src\WOKTclLib\template.vc9x_64" "%installPath%\lib\" +xcopy "src\WOKTclLib\textfile_adm.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\textfile_rdonly.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\toolkit.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\toolkit_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\transient.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\ud2cvs_unix" "%installPath%\lib\" +xcopy "src\WOKTclLib\unit.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\unit_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\unit_rdonly.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\upack.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\VC.example" "%installPath%\lib\" +xcopy "src\WOKTclLib\warehouse.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\wbuild.hlp" "%installPath%\lib\" +xcopy "src\WOKTclLib\wbuild.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wbuild.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\wcheck.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wcompare.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\WCOMPATIBLE.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wnews.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wnews_trigger.example" "%installPath%\lib\" +xcopy "src\WOKTclLib\wok.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wok-comm.el" "%installPath%\lib\" +xcopy "src\WOKTclLib\Wok_Init.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokcd.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokclient.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokCOO.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokCreations.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokcvs.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokDeletions.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokEDF.hlp" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokEDF.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokemacs.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokinit.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokinterp.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokMainHelp.hlp" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokNAV.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokPrepareHelp.hlp" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokPRM.hlp" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokPRM.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokprocs.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokPROP.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokQUE.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokRPR.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokRPRHelp.hlp" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokSEA.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\woksh.el" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokStuff.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\WOKVC.NOBASE" "%installPath%\lib\" +xcopy "src\WOKTclLib\WOKVC.RCS" "%installPath%\lib\" +xcopy "src\WOKTclLib\WOKVC.SCCS" "%installPath%\lib\" +xcopy "src\WOKTclLib\WOKVC.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wokWaffQueueHelp.hlp" "%installPath%\lib\" +xcopy "src\WOKTclLib\work.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\workbench.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\workbench_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\workbenchq.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\workshop.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\workshop_open.xpm" "%installPath%\lib\" +xcopy "src\WOKTclLib\wprepare.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wstore.tcl" "%installPath%\lib\" +xcopy "src\WOKTclLib\wstore_trigger.example" "%installPath%\lib\" +xcopy "src\WOKTclLib\wutils.tcl" "%installPath%\lib\" + +echo. +echo =========end operation=========== +if not "%doNotCopyForeignFileList%" == "" ( + echo "%doNotCopyForeignFileList% files has not been copied" +) +echo. diff --git a/collect_binary.sh b/collect_binary.sh new file mode 100644 index 0000000..be3511e --- /dev/null +++ b/collect_binary.sh @@ -0,0 +1,381 @@ +#!/bin/bash + +# $1 - debug OR release +# $2 - compiler name +# $3 - related package name + +configFile="collect_binary.cfg" + +installRelatePath="package" +if [ "$3" != "" ]; then + installRelatePath=$3 +fi + +if [ "$1" == "" -o "$2" == "" ]; then + echo "Some arguments are empty. Please try again. For example," + echo "$0 release make installDirRelatedPath" + exit 1 +fi + +# # Setup environment +source ./env.sh "$1" + +mkdir -p $installRelatePath/doc +mkdir -p $installRelatePath/lib/lin +mkdir -p $installRelatePath/lib/templates +mkdir -p $installRelatePath/home +#mkdir -p $installRelatePath/site/WokConfig.app/ +#mkdir -p $installRelatePath/site/WokEmacs.app/ +mkdir -p $installRelatePath/site/public_el/ +mkdir -p $installRelatePath/wok_entities + +mkdir -p $installRelatePath/3rdparty/lin${ARCH}/codegen +mkdir -p $installRelatePath/3rdparty/lin${ARCH}/tcltk + +# occt libs checking +preOCCTLibPath="${CASROOT}/lin${ARCH}/${cmdArg2}/lib${CASDEB}" +if [ -e "$preOCCTLibPath/libTKernel.so" ]; then + cp -f "$preOCCTLibPath/libTKernel.so" $installRelatePath/lib/lin/ +else + echo "$preOCCTLibPath/libTKernel.so does not exist" +fi +if [ -e "$preOCCTLibPath/libTKAdvTools.so" ]; then + cp -f "$preOCCTLibPath/libTKAdvTools.so" $installRelatePath/lib/lin/ +else + echo "$preOCCTLibPath/libTKAdvTools.so does not exist" +fi + +#wok libs checking +preWOKLibPath="./lin${ARCH}/${cmdArg2}/lib${CASDEB}" +if [ -d "$preWOKLibPath" ]; then + cp -f -R "$preWOKLibPath/*" $installRelatePath/lib/lin/ +else + echo "$preWOKLibPath folder DOES NOT exist! " +fi + +cp -f src/WOKsite/tclshrc.tcl $installRelatePath/home/ +cp -f src/WOKsite/.emacs $installRelatePath/home/ +cp -f src/WOKsite/.emacs $installRelatePath/home/ + +cp -f -R src/WOKsite/public_el/* $installRelatePath/site/public_el/ +cp -f custom.sh $installRelatePath/site/ + +cp -f src/CPPJini/CPPJini_General.edl $installRelatePath/lib/ +cp -f src/CPPJini/CPPJini_Template.edl $installRelatePath/lib/ + +cp -f src/WOKOBJS/OBJS.edl $installRelatePath/lib/ +cp -f src/WOKOBJS/OBJSSCHEMA.edl $installRelatePath/lib/ + +cp -f src/WOKLibs/pkgIndex.tcl $installRelatePath/lib/ + +cp -f src/TCPPExt/TCPPExt_MethodTemplate.edl $installRelatePath/lib/ + +cp -f src/WOKDeliv/WOKDeliv_DelivExecSource.tcl $installRelatePath/lib/ +cp -f src/WOKDeliv/WOKDeliv_FRONTALSCRIPT.edl $installRelatePath/lib/ +cp -f src/WOKDeliv/WOKDeliv_LDSCRIPT.edl $installRelatePath/lib/ + +cp -f src/CSFDBSchema/CSFDBSchema_Template.edl $installRelatePath/lib/ + +cp -f src/WOKUtils/EDL.edl $installRelatePath/lib/ + +cp -f src/CPPIntExt/Engine_Template.edl $installRelatePath/lib/ +cp -f src/CPPIntExt/Interface_Template.edl $installRelatePath/lib/ + +cp -f src/WOKTclTools/ENV.edl $installRelatePath/lib/ + +cp -f src/WOKEntityDef/FILENAME.edl $installRelatePath/lib/ + +cp -f src/CPPExt/CPPExt_Standard.edl $installRelatePath/lib/ +cp -f src/CPPExt/CPPExt_Template.edl $installRelatePath/lib/ +cp -f src/CPPExt/CPPExt_TemplateCSFDB.edl $installRelatePath/lib/ +cp -f src/CPPExt/CPPExt_TemplateOBJS.edl $installRelatePath/lib/ +cp -f src/CPPExt/CPPExt_TemplateOBJY.edl $installRelatePath/lib/ + +cp -f src/WOKOrbix/IDLFRONT.edl $installRelatePath/lib/ +cp -f src/WOKOrbix/ORBIX.edl $installRelatePath/lib/ +cp -f src/WOKOrbix/WOKOrbix_ClientObjects.tcl $installRelatePath/lib/ +cp -f src/WOKOrbix/WOKOrbix_ServerObjects.tcl $installRelatePath/lib/ + +cp -f src/WOKEntityDef/WOKEntity.edl $installRelatePath/lib/ +cp -f src/WOKEntityDef/WOKEntity_Factory.edl $installRelatePath/lib/ +cp -f src/WOKEntityDef/WOKEntity_Parcel.edl $installRelatePath/lib/ +cp -f src/WOKEntityDef/WOKEntity_ParcelUnit.edl $installRelatePath/lib/ +cp -f src/WOKEntityDef/WOKEntity_Unit.edl $installRelatePath/lib/ +cp -f src/WOKEntityDef/WOKEntity_UnitTypes.edl $installRelatePath/lib/ +cp -f src/WOKEntityDef/WOKEntity_Warehouse.edl $installRelatePath/lib/ +cp -f src/WOKEntityDef/WOKEntity_Workbench.edl $installRelatePath/lib/ +cp -f src/WOKEntityDef/WOKEntity_WorkbenchUnit.edl $installRelatePath/lib/ +cp -f src/WOKEntityDef/WOKEntity_Workshop.edl $installRelatePath/lib/ + +cp -f src/WOKStep/WOKStep_frontal.tcl $installRelatePath/lib/ +cp -f src/WOKStep/WOKStep_JavaCompile.tcl $installRelatePath/lib/ +cp -f src/WOKStep/WOKStep_JavaHeader.tcl $installRelatePath/lib/ +cp -f src/WOKStep/WOKStep_LibRename.tcl $installRelatePath/lib/ +cp -f src/WOKStep/WOKStep_ManifestEmbed.tcl $installRelatePath/lib/ +cp -f src/WOKStep/WOKStep_TclLibIdep.tcl $installRelatePath/lib/ + +cp -f src/WOKStepsDef/FRONTAL.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_ccl.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_client.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_client_wnt.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_Del.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_delivery.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_documentation.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_engine.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_engine_wnt.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_executable.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_executable_wnt.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_frontal.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_idl.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_interface.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_interface_wnt.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_jini.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_nocdlpack.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_nocdlpack_wnt.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_package.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_package_wnt.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_resource.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_schema.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_schema_DFLT.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_schema_OBJS.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_schema_OBJY.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_server.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_toolkit.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKSteps_toolkit_wnt.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKStepsDeliv.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKStepsDFLT.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKStepsOBJS.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKStepsOBJY.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKStepsOrbix.edl $installRelatePath/lib/ +cp -f src/WOKStepsDef/WOKStepsStep.edl $installRelatePath/lib/ + +cp -f src/WOKsite/wok.csh $installRelatePath/site/ +cp -f src/WOKsite/wokinit.csh $installRelatePath/site/ +cp -f src/WOKsite/DEFAULT.edl $installRelatePath/site/ +cp -f src/WOKsite/WOKSESSION.edl $installRelatePath/site/ +cp -f src/WOKsite/CreateFactory.tcl $installRelatePath/site/ +cp -f src/WOKsite/interp.tcl $installRelatePath/site/ +cp -f src/WOKsite/tclshrc.tcl $installRelatePath/site/ +cp -f src/WOKsite/wok_deps.tcl $installRelatePath/site/ +cp -f src/WOKsite/wok_depsgui.tcl $installRelatePath/site/ +cp -f src/WOKsite/wok_tclshrc.tcl $installRelatePath/site/ +cp -f src/WOKsite/wok_confgui.sh $installRelatePath/site/ +cp -f src/WOKsite/wok_emacs.sh $installRelatePath/site/ +cp -f src/WOKsite/wok_env.sh $installRelatePath/site/ +cp -f src/WOKsite/wok_init.sh $installRelatePath/site/ +cp -f src/WOKsite/wok_tclsh.sh $installRelatePath/site/ +cp -f src/WOKsite/tclshrc_Wok $installRelatePath/site/ + +cp -f src/CPPClient/CPPClient_General.edl $installRelatePath/lib/ +cp -f src/CPPClient/CPPClient_Template.edl $installRelatePath/lib/ + +# from WOKBuilderDef to lib folder +cp -f src/WOKBuilderDef/ARX.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CDLTranslate.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CMPLRS.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CMPLRS_AIX.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CMPLRS_BSD.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CMPLRS_HP.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CMPLRS_LIN.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CMPLRS_MAC.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CMPLRS_SIL.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CMPLRS_SUN.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CMPLRS_WNT.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CODEGEN.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/COMMAND.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CPP.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CPPCLIENT.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CPPENG.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CPPINT.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CPPJINI.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSF.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSF_AIX.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSF_AO1.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSF_BSD.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSF_HP.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSF_LIN.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSF_MAC.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSF_SIL.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSF_SUN.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSF_WNT.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/CSFDBSCHEMA.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/JAVA.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/LD.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/LDAR.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/LDEXE.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/LDSHR.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/LIB.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/LINK.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/LINKSHR.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/STUBS.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/TCPP.edl $installRelatePath/lib/ +cp -f src/WOKBuilderDef/USECONFIG.edl $installRelatePath/lib/ + +cp -f src/WOKTclLib/templates/env.sh $installRelatePath/lib/templates/ +cp -f src/WOKTclLib/templates/draw.sh $installRelatePath/lib/templates/ +cp -f src/WOKTclLib/templates/codeblocks.sh $installRelatePath/lib/templates/ +cp -f src/WOKTclLib/templates/build_configure $installRelatePath/lib/templates/ +cp -f src/WOKTclLib/templates/custom.sh.in $installRelatePath/lib/templates/ +cp -f src/WOKTclLib/templates/acinclude.m4 $installRelatePath/lib/templates/ +cp -f src/WOKTclLib/templates/template.mam $installRelatePath/lib/templates/ +cp -f src/WOKTclLib/templates/template.mamx $installRelatePath/lib/templates/ +cp -f src/WOKTclLib/templates/template.ac $installRelatePath/lib/templates/ + +cp -f src/WOKTclLib/tclIndex $installRelatePath/lib/ +cp -f src/WOKTclLib/abstract.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/admin.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/arb.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/back.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/Browser.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/browser.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/BrowserOMT.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/BrowserSearch.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/bycol.xbm $installRelatePath/lib/ +cp -f src/WOKTclLib/bylast.xbm $installRelatePath/lib/ +cp -f src/WOKTclLib/bylong.xbm $installRelatePath/lib/ +cp -f src/WOKTclLib/byrow.xbm $installRelatePath/lib/ +cp -f src/WOKTclLib/caution.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/cback.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/ccl.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/ccl_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/cell.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/cfrwd.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/client.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/client_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/config.h $installRelatePath/lib/ +cp -f src/WOKTclLib/create.xpm $installRelatePath/site/ +cp -f src/WOKTclLib/danger.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/delete.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/delivery.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/delivery_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/dep.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/documentation.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/documentation_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/engine.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/engine_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/envir.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/envir_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/executable.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/executable_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/factory.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/factory_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/file.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/FILES $installRelatePath/lib/ +cp -f src/WOKTclLib/frontal.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/frontal_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/gettable.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/idl.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/idl_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/interface.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/interface_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/jini.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/jini_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/journal.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/MkBuild.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/news_cpwb.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/nocdlpack.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/nocdlpack_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/notes.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/OCCTDocumentation.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/OCCTGetVersion.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/opencascade.gif $installRelatePath/lib/ +cp -f src/WOKTclLib/OS.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/osutils.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/package.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/package_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/params.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/parcel.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/parcel_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/patch.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/patches.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/path.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/persistent.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/pqueue.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/prepare.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/private.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/queue.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/README $installRelatePath/lib/ +cp -f src/WOKTclLib/reposit.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/resource.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/resource_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/rotate.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/scheck.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/schema.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/schema_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/see.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/see_closed.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/server.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/server_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/source.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/storable.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/tclx.nt $installRelatePath/lib/ +cp -f src/WOKTclLib/textfile_adm.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/textfile_rdonly.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/toolkit.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/toolkit_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/transient.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/ud2cvs_unix $installRelatePath/lib/ +cp -f src/WOKTclLib/unit.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/unit_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/unit_rdonly.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/upack.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/VC.example $installRelatePath/lib/ +cp -f src/WOKTclLib/warehouse.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/wbuild.hlp $installRelatePath/lib/ +cp -f src/WOKTclLib/wbuild.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wbuild.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/wcheck.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wcompare.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/WCOMPATIBLE.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wnews.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wnews_trigger.example $installRelatePath/lib/ +cp -f src/WOKTclLib/wok.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wok-comm.el $installRelatePath/lib/ +cp -f src/WOKTclLib/Wok_Init.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokcd.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/wokclient.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokCOO.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokCreations.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokcvs.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokDeletions.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokEDF.hlp $installRelatePath/lib/ +cp -f src/WOKTclLib/wokEDF.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokemacs.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokinit.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokinterp.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokMainHelp.hlp $installRelatePath/lib/ +cp -f src/WOKTclLib/wokNAV.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokPrepareHelp.hlp $installRelatePath/lib/ +cp -f src/WOKTclLib/wokPRM.hlp $installRelatePath/lib/ +cp -f src/WOKTclLib/wokPRM.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokprocs.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokPROP.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokQUE.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokRPR.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokRPRHelp.hlp $installRelatePath/lib/ +cp -f src/WOKTclLib/wokSEA.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/woksh.el $installRelatePath/lib/ +cp -f src/WOKTclLib/wokStuff.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/WOKVC.NOBASE $installRelatePath/lib/ +cp -f src/WOKTclLib/WOKVC.RCS $installRelatePath/lib/ +cp -f src/WOKTclLib/WOKVC.SCCS $installRelatePath/lib/ +cp -f src/WOKTclLib/WOKVC.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wokWaffQueueHelp.hlp $installRelatePath/lib/ +cp -f src/WOKTclLib/work.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/workbench.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/workbench_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/workbenchq.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/workshop.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/workshop_open.xpm $installRelatePath/lib/ +cp -f src/WOKTclLib/wprepare.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wstore.tcl $installRelatePath/lib/ +cp -f src/WOKTclLib/wstore_trigger.example $installRelatePath/lib/ +cp -f src/WOKTclLib/wutils.tcl $installRelatePath/lib/ + +# echo. +# echo =========end operation=========== +# if not "%doNotCopyForeignFileList%" == "" ( + # echo "%doNotCopyForeignFileList% files has not been copied" +# ) +# echo. diff --git a/src/WOKTclLib/OS.tcl b/src/WOKTclLib/OS.tcl index d6712f6..662ef77 100644 --- a/src/WOKTclLib/OS.tcl +++ b/src/WOKTclLib/OS.tcl @@ -3272,7 +3272,7 @@ proc OS:MKPRC { {theOutDir {}} {theProjectType {}} {theIDE ""} } { puts stderr "Error: Could not create output directory \"$anOutDir\"" return } - + # Generating project files for the selected IDE switch -exact -- "$theIDE" { "vc7" - @@ -3283,7 +3283,12 @@ proc OS:MKPRC { {theOutDir {}} {theProjectType {}} {theIDE ""} } { "cmk" { OS:MKCMK $anOutDir $aModules $anAllSolution } "amk" { OS:MKAMK $anOutDir $aModules "adm/${aWokStation}/${theIDE}"} } - + + # generate config.txt file + if { ${anAllSolution} == "Products" && "$::env(WOKSTATION)" == "wnt" } { + osutils:mkCollectScript "collect_binary.cfg" "$anOutRoot/../" ${theIDE} $::env(ARCH) "release" + } + # Store generated GUIDs map set anOutFile [open "$aGuidsFilePath" "w"] fconfigure $anOutFile -translation lf diff --git a/src/WOKTclLib/osutils.tcl b/src/WOKTclLib/osutils.tcl index a052c57..10bf98c 100755 --- a/src/WOKTclLib/osutils.tcl +++ b/src/WOKTclLib/osutils.tcl @@ -1968,6 +1968,19 @@ proc osutils:in:__AMDEPTRUE__ { l } { return [wokUtils:EASY:FmtSimple1 $fmt $l] } +proc osutils:mkCollectScript { theOutCfgFileName theProjectRootPath theIDE theBitness theBuildType } { + set aCfgFileBuff [list] + + lappend aCfgFileBuff "cmdArg1=${theIDE}" + lappend aCfgFileBuff "cmdArg2=${theBitness}" + lappend aCfgFileBuff "cmdArg3=${theBuildType}" + + set aCfgFile [open [set fdsw [file join ${theProjectRootPath} $theOutCfgFileName]] w] + fconfigure $aCfgFile -translation crlf + puts $aCfgFile [join $aCfgFileBuff "\n"] + close $aCfgFile +} + proc osutils:tkinfo { theOutDir theToolKit theUsedToolKits theIncPaths theTKDefines theTKSrcFiles } { set aWokStation "$::env(WOKSTATION)" diff --git a/src/WOKTclLib/template.mam b/src/WOKTclLib/template.mam deleted file mode 100755 index 2fee605..0000000 --- a/src/WOKTclLib/template.mam +++ /dev/null @@ -1,21 +0,0 @@ -# Makefile.am for Open Cascade toolkit __TKNAM__ -srcdir = @srcdir@ - -VPATH = @srcdir@ : \ -__VPATH__ - -AM_CXXFLAGS = __CXXFLAG__ - -AM_CFLAGS = __CFLAG__ - -INCLUDES = __EXTERNINC__ \ --I@top_srcdir@/inc \ -__INCLUDES__ - -lib_LTLIBRARIES=lib__TKNAM__.la - -lib__TKNAM___la_LIBADD = \ -__LIBADD____EXTERNLIB__ - -lib__TKNAM___la_SOURCES = \ -__SOURCES__ diff --git a/src/WOKTclLib/template.mamx b/src/WOKTclLib/template.mamx deleted file mode 100755 index f5465e1..0000000 --- a/src/WOKTclLib/template.mamx +++ /dev/null @@ -1,10 +0,0 @@ -# Makefile.am for executable __XQTNAM__ -srcdir = @srcdir@ - -VPATH = @srcdir@ : \ -@top_srcdir@/src/__XQTNAM__ - -INCLUDES =__EXTERNINC__ \ --I@top_srcdir@/inc \ --I@top_srcdir@/src/__XQTNAM__ - diff --git a/src/WOKTclLib/template.vc10 b/src/WOKTclLib/template.vc10 deleted file mode 100644 index 2ab1112..0000000 --- a/src/WOKTclLib/template.vc10 +++ /dev/null @@ -1,126 +0,0 @@ - - - - - Debug - Win32 - - - Release - Win32 - - - - __PROJECT_GUID__ - - - - DynamicLibrary - - - DynamicLibrary - - - - - - - - - - - - - <_ProjectFileVersion>10.0.30319.1 - .\..\..\..\win32\vc10\bin\ - .\..\..\..\win32\vc10\obj\__TKNAM__\ - false - .\..\..\..\win32\vc10\bind\ - .\..\..\..\win32\vc10\objd\__TKNAM__\ - false - - - - NDEBUG;%(PreprocessorDefinitions) - true - true - Win32 - .\..\..\..\win32\vc10\bin\__TKNAM__.tlb - - - - - /DWNT %(AdditionalOptions) - MaxSpeed - OnlyExplicitInline - NDEBUG;WIN32;_WINDOWS;WNT;No_Exception;CSFDB;$(CSF_DEFINES);%(PreprocessorDefinitions) - true - Async - MultiThreadedDLL - true - .\..\..\..\win32\vc10\obj\__TKNAM__/ - .\..\..\..\win32\vc10\obj\__TKNAM__/ - .\..\..\..\win32\vc10\obj\__TKNAM__/ - Level3 - true - 4996;%(DisableSpecificWarnings) - - - NDEBUG;%(PreprocessorDefinitions) - - - __TKDEP__;ws2_32.lib;vfw32.lib;%(AdditionalDependencies) - .\..\..\..\win32\vc10\bin\__TKNAM__.dll - true - ..\..\..\win32\vc10\lib;%(AdditionalLibraryDirectories) - .\..\..\..\win32\vc10\bin\__TKNAM__.pdb - Console - ..\..\..\win32\vc10\lib\__TKNAM__.lib - - - - - _DEBUG;%(PreprocessorDefinitions) - true - true - Win32 - .\..\..\..\win32\vc10\bind\__TKNAM__.tlb - - - - - /DWNT %(AdditionalOptions) - Disabled - OnlyExplicitInline - DEB;_DEBUG;WIN32;_WINDOWS;WNT;CSFDB;$(CSF_DEFINES);%(PreprocessorDefinitions) - Async - MultiThreadedDebugDLL - .\..\..\..\win32\vc10\objd\__TKNAM__/ - .\..\..\..\win32\vc10\objd\__TKNAM__/ - .\..\..\..\win32\vc10\objd\__TKNAM__/ - Level3 - true - ProgramDatabase - Default - 4996;%(DisableSpecificWarnings) - - - _DEBUG;%(PreprocessorDefinitions) - - - __TKDEP__;ws2_32.lib;vfw32.lib;%(AdditionalDependencies) - .\..\..\..\win32\vc10\bind\__TKNAM__.dll - true - ..\..\..\win32\vc10\libd;%(AdditionalLibraryDirectories) - true - ..\..\..\win32\vc10\bind\__TKNAM__.pdb - Console - ..\..\..\win32\vc10\libd\__TKNAM__.lib - - - -__FILES__ - - - - diff --git a/src/WOKTclLib/template.vc10_64 b/src/WOKTclLib/template.vc10_64 deleted file mode 100644 index d04a193..0000000 --- a/src/WOKTclLib/template.vc10_64 +++ /dev/null @@ -1,126 +0,0 @@ - - - - - Debug - x64 - - - Release - x64 - - - - __PROJECT_GUID__ - - - - DynamicLibrary - - - DynamicLibrary - - - - - - - - - - - - - <_ProjectFileVersion>10.0.30319.1 - .\..\..\..\win64\vc10\bin\ - .\..\..\..\win64\vc10\obj\__TKNAM__\ - false - .\..\..\..\win64\vc10\bind\ - .\..\..\..\win64\vc10\objd\__TKNAM__\ - false - - - - NDEBUG;%(PreprocessorDefinitions) - true - true - x64 - .\..\..\..\win64\vc10\bin\__TKNAM__.tlb - - - - - /DWNT %(AdditionalOptions) - MaxSpeed - OnlyExplicitInline - NDEBUG;WIN64;_WINDOWS;WNT;No_Exception;CSFDB;$(CSF_DEFINES);_OCC64;%(PreprocessorDefinitions) - true - Async - MultiThreadedDLL - true - .\..\..\..\win64\vc10\obj\__TKNAM__/ - .\..\..\..\win64\vc10\obj\__TKNAM__/ - .\..\..\..\win64\vc10\obj\__TKNAM__/ - Level3 - true - 4996;%(DisableSpecificWarnings) - - - NDEBUG;%(PreprocessorDefinitions) - - - __TKDEP__;ws2_32.lib;vfw32.lib;%(AdditionalDependencies) - .\..\..\..\win64\vc10\bin\__TKNAM__.dll - true - ..\..\..\win64\vc10\lib;%(AdditionalLibraryDirectories) - .\..\..\..\win64\vc10\bin\__TKNAM__.pdb - Console - ..\..\..\win64\vc10\lib\__TKNAM__.lib - - - - - _DEBUG;%(PreprocessorDefinitions) - true - true - x64 - .\..\..\..\win64\vc10\bind\__TKNAM__.tlb - - - - - /DWNT %(AdditionalOptions) - Disabled - OnlyExplicitInline - DEB;_DEBUG;WIN64;_WINDOWS;WNT;CSFDB;$(CSF_DEFINES);_OCC64;%(PreprocessorDefinitions) - Async - MultiThreadedDebugDLL - .\..\..\..\win64\vc10\objd\__TKNAM__/ - .\..\..\..\win64\vc10\objd\__TKNAM__/ - .\..\..\..\win64\vc10\objd\__TKNAM__/ - Level3 - true - ProgramDatabase - Default - 4996;%(DisableSpecificWarnings) - - - _DEBUG;%(PreprocessorDefinitions) - - - __TKDEP__;ws2_32.lib;vfw32.lib;%(AdditionalDependencies) - .\..\..\..\win64\vc10\bind\__TKNAM__.dll - true - ..\..\..\win64\vc10\libd;%(AdditionalLibraryDirectories) - true - ..\..\..\win64\vc10\bind\__TKNAM__.pdb - Console - ..\..\..\win64\vc10\libd\__TKNAM__.lib - - - -__FILES__ - - - - diff --git a/src/WOKTclLib/template.vc10x b/src/WOKTclLib/template.vc10x deleted file mode 100644 index d2227a3..0000000 --- a/src/WOKTclLib/template.vc10x +++ /dev/null @@ -1,124 +0,0 @@ - - - - - Debug - Win32 - - - Release - Win32 - - - - __PROJECT_GUID__ - - - - Application - - - Application - - - - - - - - - - - - - <_ProjectFileVersion>10.0.30319.1 - .\..\..\..\win32\vc10\bin\ - .\..\..\..\win32\vc10\obj\__XQTNAM__\ - false - .\..\..\..\win32\vc10\bind\ - .\..\..\..\win32\vc10\objd\__XQTNAM__\ - false - - - - NDEBUG;%(PreprocessorDefinitions) - true - true - Win32 - .\..\..\..\win32\vc10\bin\__XQTNAM__.tlb - - - - - /DWNT %(AdditionalOptions) - MaxSpeed - OnlyExplicitInline - NDEBUG;WIN32;_WINDOWS;WNT;No_Exception;CSFDB;$(CSF_DEFINES);%(PreprocessorDefinitions) - true - Async - MultiThreadedDLL - true - .\..\..\..\win32\vc10\obj\__XQTNAM__/ - .\..\..\..\win32\vc10\obj\__XQTNAM__/ - .\..\..\..\win32\vc10\obj\__XQTNAM__/ - Level3 - true - 4996;%(DisableSpecificWarnings) - - - NDEBUG;%(PreprocessorDefinitions) - - - __TKDEP__;%(AdditionalDependencies) - true - ..\..\..\win32\vc10\lib;%(AdditionalLibraryDirectories) - .\..\..\..\win32\vc10\bin\__XQTNAM__.pdb - Console - ..\..\..\win32\vc10\lib\__XQTNAM__.lib - - - - - _DEBUG;%(PreprocessorDefinitions) - true - true - Win32 - .\..\..\..\win32\vc10\bind\__XQTNAM__.tlb - - - - - /DWNT %(AdditionalOptions) - Disabled - OnlyExplicitInline - DEB;_DEBUG;WIN32;_WINDOWS;WNT;CSFDB;$(CSF_DEFINES);%(PreprocessorDefinitions) - Async - MultiThreadedDebugDLL - .\..\..\..\win32\vc10\objd\__XQTNAM__/ - .\..\..\..\win32\vc10\objd\__XQTNAM__/ - .\..\..\..\win32\vc10\objd\__XQTNAM__/ - Level3 - true - ProgramDatabase - Default - 4996;%(DisableSpecificWarnings) - - - _DEBUG;%(PreprocessorDefinitions) - - - __TKDEP__;%(AdditionalDependencies) - true - ..\..\..\win32\vc10\libd;%(AdditionalLibraryDirectories) - true - ..\..\..\win32\vc10\bind\__XQTNAM__.pdb - Console - ..\..\..\win32\vc10\libd\__XQTNAM__.lib - - - -__FILES__ - - - - diff --git a/src/WOKTclLib/template.vc10x_64 b/src/WOKTclLib/template.vc10x_64 deleted file mode 100644 index 62041d1..0000000 --- a/src/WOKTclLib/template.vc10x_64 +++ /dev/null @@ -1,124 +0,0 @@ - - - - - Debug - x64 - - - Release - x64 - - - - __PROJECT_GUID__ - - - - Application - - - Application - - - - - - - - - - - - - <_ProjectFileVersion>10.0.30319.1 - .\..\..\..\win64\vc10\bin\ - .\..\..\..\win64\vc10\obj\__XQTNAM__\ - false - .\..\..\..\win64\vc10\bind\ - .\..\..\..\win64\vc10\objd\__XQTNAM__\ - false - - - - NDEBUG;%(PreprocessorDefinitions) - true - true - x64 - .\..\..\..\win64\vc10\bin\__XQTNAM__.tlb - - - - - /DWNT %(AdditionalOptions) - MaxSpeed - OnlyExplicitInline - NDEBUG;WIN64;_WINDOWS;WNT;No_Exception;CSFDB;$(CSF_DEFINES);_OCC64;%(PreprocessorDefinitions) - true - Async - MultiThreadedDLL - true - .\..\..\..\win64\vc10\obj\__XQTNAM__/ - .\..\..\..\win64\vc10\obj\__XQTNAM__/ - .\..\..\..\win64\vc10\obj\__XQTNAM__/ - Level3 - true - 4996;%(DisableSpecificWarnings) - - - NDEBUG;%(PreprocessorDefinitions) - - - __TKDEP__;%(AdditionalDependencies) - true - ..\..\..\win64\vc10\lib;%(AdditionalLibraryDirectories) - .\..\..\..\win64\vc10\bin\__XQTNAM__.pdb - Console - ..\..\..\win64\vc10\lib\__XQTNAM__.lib - - - - - _DEBUG;%(PreprocessorDefinitions) - true - true - x64 - .\..\..\..\win64\vc10\bind\__XQTNAM__.tlb - - - - - /DWNT %(AdditionalOptions) - Disabled - OnlyExplicitInline - DEB;_DEBUG;WIN64;_WINDOWS;WNT;CSFDB;$(CSF_DEFINES);_OCC64;%(PreprocessorDefinitions) - Async - MultiThreadedDebugDLL - .\..\..\..\win64\vc10\objd\__XQTNAM__/ - .\..\..\..\win64\vc10\objd\__XQTNAM__/ - .\..\..\..\win64\vc10\objd\__XQTNAM__/ - Level3 - true - ProgramDatabase - Default - 4996;%(DisableSpecificWarnings) - - - _DEBUG;%(PreprocessorDefinitions) - - - __TKDEP__;%(AdditionalDependencies) - true - ..\..\..\win64\vc10\libd;%(AdditionalLibraryDirectories) - true - ..\..\..\win64\vc10\bind\__XQTNAM__.pdb - Console - ..\..\..\win64\vc10\libd\__XQTNAM__.lib - - - -__FILES__ - - - - diff --git a/src/WOKTclLib/template.vc6 b/src/WOKTclLib/template.vc6 deleted file mode 100755 index b57df1f..0000000 --- a/src/WOKTclLib/template.vc6 +++ /dev/null @@ -1,94 +0,0 @@ -# Microsoft Developer Studio Project File - Name="__TKNAM__" - Package Owner=<4> -# Microsoft Developer Studio Generated Build File, Format Version 6.00 -# ** DO NOT EDIT ** - -# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 - -CFG=__TKNAM__ - Win32 Debug -!MESSAGE This is not a valid makefile. To build this project using NMAKE, -!MESSAGE use the Export Makefile command and run -!MESSAGE -!MESSAGE NMAKE /f "__TKNAM__.mak". -!MESSAGE -!MESSAGE You can specify a configuration when running NMAKE -!MESSAGE by defining the macro CFG on the command line. For example: -!MESSAGE -!MESSAGE NMAKE /f "__TKNAM__.mak" CFG="__TKNAM__ - Win32 Debug" -!MESSAGE -!MESSAGE Possible choices for configuration are: -!MESSAGE -!MESSAGE "__TKNAM__ - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library") -!MESSAGE "__TKNAM__ - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") -!MESSAGE - -# Begin Project -# PROP AllowPerConfigDependencies 0 -# PROP Scc_ProjName "" -# PROP Scc_LocalPath "" -CPP=cl.exe -MTL=midl.exe -RSC=rc.exe - -!IF "$(CFG)" == "__TKNAM__ - Win32 Release" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 0 -# PROP BASE Output_Dir "Release" -# PROP BASE Intermediate_Dir "..\..\..\win32\vc6\obj\__TKNAM__" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 0 -# PROP Output_Dir "..\..\..\win32\vc6\bin" -# PROP Intermediate_Dir "..\..\..\win32\vc6\obj\__TKNAM__" -# PROP Ignore_Export_Lib 0 -# PROP Target_Dir "" -# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /FD /c -# ADD CPP /nologo /MD /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "WNT" /D "CSFDB" /D "No_Exception" /FD /c -# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /o "NUL" /win32 -# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /o "NUL" /win32 -# ADD BASE RSC /l 0x40c /d "NDEBUG" -# ADD RSC /l 0x40c /d "NDEBUG" -BSC32=bscmake.exe -# ADD BASE BSC32 /nologo -# ADD BSC32 /nologo -LINK32=link.exe -# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386 -# ADD LINK32 __TKDEP__ opengl32.lib glu32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ws2_32.lib vfw32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /incremental:no /machine:I386 /libpath:"..\..\..\win32\vc6\lib" /implib:"..\..\..\win32\vc6\lib\__TKNAM__.lib" - -!ELSEIF "$(CFG)" == "__TKNAM__ - Win32 Debug" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 1 -# PROP BASE Output_Dir "Debug" -# PROP BASE Intermediate_Dir "..\..\..\win32\vc6\objd\__TKNAM__" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 1 -# PROP Output_Dir "..\..\..\win32\vc6\bind" -# PROP Intermediate_Dir "..\..\..\win32\vc6\objd\__TKNAM__" -# PROP Ignore_Export_Lib 0 -# PROP Target_Dir "" -# ADD BASE CPP /nologo /W3 /GX /Zi /Od /D "WIN32" /D "DEB" /D "_DEBUG" /D "_WINDOWS" /FD /c -# ADD CPP /nologo /MDd /W3 /GX /Zi /Od /D "WIN32" /D "DEB" /D "_DEBUG" /D "_WINDOWS" /D "WNT" /D "CSFDB" /FD /c -# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /o "NUL" /win32 -# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /o "NUL" /win32 -# ADD BASE RSC /l 0x40c /d "_DEBUG" -# ADD RSC /l 0x40c /d "_DEBUG" -BSC32=bscmake.exe -# ADD BASE BSC32 /nologo -# ADD BSC32 /nologo -LINK32=link.exe -# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /debug /machine:I386 /pdbtype:sept -# ADD LINK32 __TKDEP__ opengl32.lib glu32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ws2_32.lib vfw32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /incremental:no /debug /machine:IX86 /libpath:"..\..\..\win32\vc6\libd" /pdb:"..\..\..\win32\vc6\bind\__TKNAM__.pdb" /implib:"..\..\..\win32\vc6\libd\__TKNAM__.lib" - -!ENDIF - -# Begin Target - -# Name "__TKNAM__ - Win32 Release" -# Name "__TKNAM__ - Win32 Debug" -# Begin Group "Source files" -__FILES__ -# End Group -# End Target -# End Project diff --git a/src/WOKTclLib/template.vc6x b/src/WOKTclLib/template.vc6x deleted file mode 100755 index b3ec4af..0000000 --- a/src/WOKTclLib/template.vc6x +++ /dev/null @@ -1,94 +0,0 @@ -# Microsoft Developer Studio Project File - Name="__XQTNAM__" - Package Owner=<4> -# Microsoft Developer Studio Generated Build File, Format Version 6.00 -# ** DO NOT EDIT ** - -# TARGTYPE "Win32 (x86) Application" 0x0103 - -CFG=__XQTNAM__ - Win32 Debug -!MESSAGE This is not a valid makefile. To build this project using NMAKE, -!MESSAGE use the Export Makefile command and run -!MESSAGE -!MESSAGE NMAKE /f "__XQTNAM__.mak". -!MESSAGE -!MESSAGE You can specify a configuration when running NMAKE -!MESSAGE by defining the macro CFG on the command line. For example: -!MESSAGE -!MESSAGE NMAKE /f "__XQTNAM__.mak" CFG="__XQTNAM__ - Win32 Debug" -!MESSAGE -!MESSAGE Possible choices for configuration are: -!MESSAGE -!MESSAGE "__XQTNAM__ - Win32 Release" (based on "Win32 (x86) Console Application") -!MESSAGE "__XQTNAM__ - Win32 Debug" (based on "Win32 (x86) Console Application") -!MESSAGE - -# Begin Project -# PROP AllowPerConfigDependencies 0 -# PROP Scc_ProjName "" -# PROP Scc_LocalPath "" -CPP=cl.exe -MTL=midl.exe -RSC=rc.exe - -!IF "$(CFG)" == "__XQTNAM__ - Win32 Release" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 0 -# PROP BASE Output_Dir "Release" -# PROP BASE Intermediate_Dir "..\..\..\win32\obj\__XQTNAM__" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 0 -# PROP Output_Dir "..\..\..\win32\bin" -# PROP Intermediate_Dir "..\..\..\win32\obj\__XQTNAM__" -# PROP Ignore_Export_Lib 0 -# PROP Target_Dir "" -# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /FD /c -# ADD CPP /nologo __COMPOPT__ /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "No_Exception" /D "_WINDOWS" /D "WNT" /D "CSFDB" /FD /c -# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32 -# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32 -# ADD BASE RSC /l 0x409 /d "NDEBUG" -# ADD RSC /l 0x409 /d "NDEBUG" -BSC32=bscmake.exe -# ADD BASE BSC32 /nologo -# ADD BSC32 /nologo -LINK32=link.exe -# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 -# ADD LINK32 __TKDEP__ /nologo /subsystem:console /machine:I386 /libpath:"..\..\..\win32\lib" /implib:"..\..\..\win32\lib\__XQTNAM__.lib" - -!ELSEIF "$(CFG)" == "__XQTNAM__ - Win32 Debug" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 1 -# PROP BASE Output_Dir "Debug" -# PROP BASE Intermediate_Dir "..\..\..\win32\objd\__XQTNAM__" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 1 -# PROP Output_Dir "..\..\..\win32\bind" -# PROP Intermediate_Dir "..\..\..\win32\objd\__XQTNAM__" -# PROP Ignore_Export_Lib 0 -# PROP Target_Dir "" -# ADD BASE CPP /nologo /W3 /GX /Zi /Od /D "WIN32" /D "DEB" /D "_DEBUG" /D "_WINDOWS" /FD /GZ /c -# ADD CPP /nologo __COMPOPTD__ /W3 /GX /Zi /Od /D "WIN32" /D "DEB" /D "_DEBUG" /D "_WINDOWS" /D "WNT" /D "CSFDB" /FD /GZ /c -# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32 -# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32 -# ADD BASE RSC /l 0x409 /d "_DEBUG" -# ADD RSC /l 0x409 /d "_DEBUG" -BSC32=bscmake.exe -# ADD BASE BSC32 /nologo -# ADD BSC32 /nologo -LINK32=link.exe -# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept -# ADD LINK32 __TKDEP__ /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept /libpath:"..\..\..\win32\libd" /implib:"..\..\..\win32\libd\__XQTNAM__.lib" - -!ENDIF - -# Begin Target - -# Name "__XQTNAM__ - Win32 Release" -# Name "__XQTNAM__ - Win32 Debug" -# Begin Group "Source Files" -__FILES__ -# End Group -# End Target -# End Project diff --git a/src/WOKTclLib/template.vc7 b/src/WOKTclLib/template.vc7 deleted file mode 100755 index b666b89..0000000 --- a/src/WOKTclLib/template.vc7 +++ /dev/null @@ -1,156 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/template.vc7x b/src/WOKTclLib/template.vc7x deleted file mode 100755 index dced55f..0000000 --- a/src/WOKTclLib/template.vc7x +++ /dev/null @@ -1,150 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/template.vc8 b/src/WOKTclLib/template.vc8 deleted file mode 100755 index ba13398..0000000 --- a/src/WOKTclLib/template.vc8 +++ /dev/null @@ -1,220 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/template.vc8_64 b/src/WOKTclLib/template.vc8_64 deleted file mode 100755 index d9a3aa1..0000000 --- a/src/WOKTclLib/template.vc8_64 +++ /dev/null @@ -1,221 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/template.vc8x b/src/WOKTclLib/template.vc8x deleted file mode 100755 index e2dc5bc..0000000 --- a/src/WOKTclLib/template.vc8x +++ /dev/null @@ -1,214 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/template.vc8x_64 b/src/WOKTclLib/template.vc8x_64 deleted file mode 100755 index 8276aa1..0000000 --- a/src/WOKTclLib/template.vc8x_64 +++ /dev/null @@ -1,216 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/template.vc9 b/src/WOKTclLib/template.vc9 deleted file mode 100755 index 422eaab..0000000 --- a/src/WOKTclLib/template.vc9 +++ /dev/null @@ -1,216 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/template.vc9_64 b/src/WOKTclLib/template.vc9_64 deleted file mode 100755 index 198e0f5..0000000 --- a/src/WOKTclLib/template.vc9_64 +++ /dev/null @@ -1,214 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/template.vc9x b/src/WOKTclLib/template.vc9x deleted file mode 100755 index a581439..0000000 --- a/src/WOKTclLib/template.vc9x +++ /dev/null @@ -1,207 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/template.vc9x_64 b/src/WOKTclLib/template.vc9x_64 deleted file mode 100755 index 102ffb3..0000000 --- a/src/WOKTclLib/template.vc9x_64 +++ /dev/null @@ -1,209 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/templates/env.sh b/src/WOKTclLib/templates/env.sh index 0a13cad..e106a8a 100644 --- a/src/WOKTclLib/templates/env.sh +++ b/src/WOKTclLib/templates/env.sh @@ -3,7 +3,7 @@ # go to the script directory aScriptPath=${BASH_SOURCE%/*}; if [ -d "${aScriptPath}" ]; then cd "$aScriptPath"; fi; aScriptPath="$PWD"; -export CASROOT="$aScriptPath" +export CASROOT="__CASROOT__" # Reset values export CASDEB="" diff --git a/src/WOKsite/.emacs b/src/WOKsite/.emacs new file mode 100644 index 0000000..36a76b8 --- /dev/null +++ b/src/WOKsite/.emacs @@ -0,0 +1,11 @@ +;; .emacs file for CSF Factory + +;; Setup path to WOK configuration scripts +(setq load-path (cons (concat (getenv "WOKHOME") "/site/public_el") load-path)) + +;; Load useful commands and setup default theme +(load "wok-view.el") + +;; Launch TCL shell +(load "tclsh.el") +(tclsh) diff --git a/src/WOKsite/public_el/abv-keys.el b/src/WOKsite/public_el/abv-keys.el new file mode 100644 index 0000000..2871fe5 --- /dev/null +++ b/src/WOKsite/public_el/abv-keys.el @@ -0,0 +1,55 @@ +;; abv 21.05.2009 +;; +;; This file defines a number of keyboard shortcuts taken from obsolete det +;; settings to complete the state-of-the-art eap and msv settings +;; +;; Current version is for Windows only + +; global shortcuts for tools +(define-key global-map [C-f1] 'describe-key) ; Ctrl-F1 runs help on following command +(define-key global-map [C-S-f1] 'describe-function) ; Ctrl-F1 runs help on function +(define-key global-map [S-f2] 'grep) ; Shift-F2 runs grep +(define-key global-map [M-return] 'tclsh) ; Alt-Enter runs woksh + +; windows and buffers management +(define-key global-map [C-tab] 'other-window); Ctrl-Tab switches subwindows +(define-key global-map [?\M-0] 'buffer-menu) ; Alt-0 runs buffer list +(define-key global-map [C-f4] 'kill-this-buffer) +(define-key global-map [f6] 'bury-buffer) +(define-key global-map [f5] 'delete-other-windows) +(define-key global-map [C-f5] 'split-window-vertically) + +;; switch mode of truncatiion of lines +(defun det-switch-truncating () (interactive) + (setq truncate-lines (not truncate-lines)) + (redraw-display) +) +(global-set-key [?\C-t] 'det-switch-truncating) + +;; commands to scroll buffer by single line (rather than by paragraph) +(defun det-scroll-up () "Scrolls text up" (interactive) + (scroll-down-nomark 1) + (previous-line-nomark 1) +) +(defun det-scroll-down () "Scrolls text down" (interactive) + (scroll-up-nomark 1) + (next-line-nomark 1) +) +(define-key global-map [C-up] 'det-scroll-up) +(define-key global-map [C-down] 'det-scroll-down) + +; other commands to make editors behaving in more conventional way +(define-key global-map [C-delete] 'kill-word) +(define-key global-map [?\C-y] 'kill-whole-line) +(define-key global-map [?\C-.] 'forward-sexp) +(define-key global-map [?\C-,] 'backward-sexp) + +; commands to make right keypad to work with Shift and Control modifiers +; see det-keys.el for similar commands for other platforms +(define-key global-map [C-kp-insert] 'copy-region-as-kill-nomark) +(define-key global-map [S-kp-insert] 'yank) +(define-key global-map [S-kp-delete] 'kill-region) + +; Lisp mode shortcuts to easily evaluate edited Lisp command +(define-key lisp-mode-map [C-return] 'eval-last-sexp) +(define-key emacs-lisp-mode-map [C-return] 'eval-last-sexp) diff --git a/src/WOKsite/public_el/brief.el b/src/WOKsite/public_el/brief.el new file mode 100644 index 0000000..b2767dd --- /dev/null +++ b/src/WOKsite/public_el/brief.el @@ -0,0 +1,510 @@ +;;; brief.el --- show compactly only method heads + +;;;Author : Edward AGAPOV +;;;History : Mon Jan 31 18:06:15 2000 Creation + +;;; Commentary: + +;; This is a major mode for quick method overview and search. + +;; Mode entry: brief-show-only-method-heads + +;;; Key binding: +;; (brief-key) binds 'brief-show-only-method-heads to f3 + +;; Method search itself is done by 'eap-method-fullstring defined +;; in 'method-search library; customize 'method-search-regexp-or-function +;; vriable to use 'brief-mode in other major-modes than provided in +;; 'method-search + +(require 'method-search) +(require 'hilit19) + +(defvar brief-pos-list nil + "Contains data of methods location. +A member of brief-pos-list is a list of + . pos in brief buffer + . pos in source buffer + . regexp for method head") +(defvar breif-old-size nil + "Size of source buffer the 'brief-pos-list was built for, +to know a need to update info of methods location") +(defvar breif-source-file nil + "Name of source file") +(defvar breif-source-buffer nil) +(defvar breif-old-tick nil) +(defvar brief-mode-map nil) + +(if brief-mode-map + nil + ;; keymap + (setq brief-mode-map (make-keymap)) + (suppress-keymap brief-mode-map t) + (define-key brief-mode-map [return] 'breif-return-to-method) + (define-key brief-mode-map [mouse-2] 'breif-court-fichier-mouse2) + (define-key brief-mode-map "g" 'breif-refresh-court-fichier) + (define-key brief-mode-map [C-return] 'kill-this-buffer) + (define-key brief-mode-map "q" 'bury-buffer) + ;; hilit + (if (eq 'not (car hilit-mode-enable-list)) + (setq hilit-mode-enable-list (delete 'brief-mode hilit-mode-enable-list)) + (add-to-list 'hilit-mode-enable-list 'brief-mode)) + (hilit-set-mode-patterns + 'brief-mode + '(("^%[^%]+%" nil comment ) + ("\\(Handle\\s *([^)]+)\\s *\\)?\\([_a-zA-Z0-9]+\\)\\s *(" 2 defun) + ("static \\(const \\)?[_a-zA-Z0-9()]+[ *&]+\\([^(]+\\)\\s *" 2 defun);warning) + ("(def\\w+\\s +\\([^( ]+\\)" 1 defun) + ("defcommand\\>" 0 comment) + ("\\<\\(static\\|const\\|virtual\\)\\>" 0 keyword);;path-face) + ("defscript" 0 keyword) + ) + ) + ) + +(defun brief-show-only-method-heads (&optional refresh) + "Shows only method heads found in current file. +Then, `return' or `mouse-2' at any method bring the origin file +with the cursor at the first line of the method." + (interactive "P") + (or + (equal major-mode 'brief-mode) + (let* ((sourceBuffer (current-buffer)) + (init-b-sz (buffer-size)) + (tick (buffer-modified-tick)) + (source-file buffer-file-name) + (bufferName (format " %s" (buffer-name))) + (buffer (get-buffer-create bufferName)) + (pt (point)) + newly method-pos + (get-time '(lambda () + (let ((time (current-time))) + (+ (nth 1 time) (/ (nth 2 time) 1000000.0))))) + (old-time (funcall get-time)) + (msg "Look for methods ") + eap-method-search-boundaries + ) + (set-buffer buffer) + (or (setq newly (not (and (boundp 'breif-old-size) + (local-variable-p 'breif-old-size)))) + refresh + (= init-b-sz breif-old-size) + (setq refresh t)) + + (if (not newly) + (if refresh + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; update data + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (let* ((pos-list (reverse brief-pos-list)) + (nb-of-meth (length pos-list)) + (meth-nb 1) + intrvl next-intvl cur-intvl-nb beg end + source-pos-list checked-intervals new-pos-list + s-p-l-and-ch-int nb-of-found-meths + (time (funcall get-time)) + (old-size breif-old-size) + ) + (setq msg "Update methods ") + (message msg) + (set-buffer sourceBuffer) + + ;; a trick to enable mesurement of the last method size + ;; and not to check interval (1 - <1-st method>) + (setq pos-list (append pos-list (list (list 0 (1+ old-size) "^\""))) + pos-list (cons (list 0 1 "^\"") pos-list) + source-pos-list (list (cons (point-max) "") + '(1 . "")) + ) + ;; look for previousely found methods + (while (< meth-nb nb-of-meth) + (setq nb-of-found-meths (length source-pos-list)) + + (if (= 1 (or (car (car checked-intervals)) + 2)) + (setq intrvl (car checked-intervals) + next-intvl (nth 1 checked-intervals) + cur-intvl-nb 1) + (setq intrvl '(-9 . -9) + next-intvl (car checked-intervals) + cur-intvl-nb 0)) + + (while (and (= nb-of-found-meths (length source-pos-list)) + intrvl) + (setq beg (+ 10 (cdr intrvl))) + (setq end (or (car next-intvl) + (point-max))) + (setq s-p-l-and-ch-int (brief-find-elt-in-interval meth-nb + pos-list + beg + end + source-pos-list + checked-intervals)) + (setq source-pos-list (car s-p-l-and-ch-int) + checked-intervals (cdr s-p-l-and-ch-int)) + + (setq cur-intvl-nb (1+ cur-intvl-nb) + intrvl next-intvl + next-intvl (nth cur-intvl-nb checked-intervals)) + ) + (setq meth-nb (1+ meth-nb)) + ) + + ;; try to find new meths in not checked-intervals + (setq cur-intvl-nb 0 + intrvl '(-9 . -9) + next-intvl (car checked-intervals)) + (while intrvl + (setq beg (+ 10 (cdr intrvl))) + (setq end (or (car next-intvl) + (point-max))) + (goto-char beg) + (setq eap-method-search-boundaries (cons beg end)) + (while (setq method-pos (eap-method-fullstring nil 'endPos)) + (setq source-pos-list + (car (brief-add-to-pos-list (nth 1 method-pos) + (car method-pos) + source-pos-list))) + ) + (setq cur-intvl-nb (1+ cur-intvl-nb) + intrvl next-intvl + next-intvl (nth cur-intvl-nb checked-intervals)) + ) + ;; remove buffer start and end and reverse + (setq source-pos-list (cdr (nreverse (cdr source-pos-list)))) + + ;; restore point + (goto-char pt) + + ;; erase old contens apart from the header comments + (set-buffer buffer) + (goto-char (or (car (nth 1 pos-list)) + (point-min))) + (setq buffer-read-only nil) + (delete-region (point) (point-max)) + + ;; insert the search results + (while source-pos-list + (let* ((elt (car source-pos-list)) + (meth (eap-simplified-string (cdr elt))) + ) + (setq new-pos-list (cons (list (point) + (car elt) + (eap-regexp-for-method-string meth)) + new-pos-list)) + (insert " " meth "\n") + (setq source-pos-list (cdr source-pos-list)) + ) + ) + (setq brief-pos-list new-pos-list + eap-method-search-boundaries nil) + + ) + ) ;; end update data + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; build data for the first time + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (brief-mode) + (erase-buffer) + (insert "%\nfile:\t " (file-name-nondirectory source-file) "\n%\n\n") + (set-buffer sourceBuffer) + (goto-char (point-min)) + (message "Look for methods ") + (while (setq method-pos (eap-method-fullstring nil 'endPos)) + (set-buffer buffer) + ;; elements of brief-pos-list: + ; pos in brief buffer + ; pos in source buffer + ; regexp for method head + (setq brief-pos-list (cons + (list (point) + (car (cdr method-pos)) + (eap-regexp-for-method-string (car method-pos))) + brief-pos-list)) + (insert " " (eap-simplified-string (car method-pos)) "\n") + (eap-progress-indicator (car (cdr method-pos)) init-b-sz "Look for methods ") + (set-buffer sourceBuffer)) + ) + (switch-to-buffer buffer) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; find position in buffer + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (let* ((posList brief-pos-list)) + (while (and posList (< pt (nth 1 (car posList)))) + (setq posList (cdr posList))) + (goto-char (or (car (car posList)) + (point-min))) + ) + + (if (or newly refresh) + (hilit-rehighlight-buffer t)) + (set-buffer-modified-p nil) + + (if (or newly refresh) + (message "%s- Ok. It took %s seconds" msg (- (funcall get-time) old-time )) + (message "%s- Ok" msg) + (or + (= breif-old-tick tick) + (save-excursion (set-buffer sourceBuffer) buffer-read-only) + (message + "Source buffer seems to be modified. If methods location changed, press `%s' to update" + (substitute-command-keys "\\[breif-refresh-court-fichier]") + ))) + + (setq buffer-read-only t + breif-old-size init-b-sz + breif-old-tick tick + breif-source-buffer sourceBuffer + breif-source-file source-file) + ) + )) + +(defun brief-mode () + "Show only method heads in order to overview all methods and +to find a method easily. +Type '\\[breif-return-to-method]' or '\\[breif-court-fichier-mouse2]' to get back source buffer +with cursor at the first line of the method clicked on. +Type '\\[breif-refresh-court-fichier]' to make 'brief buffer up-to-date when you know it is not. +Type '\\[bury-buffer]' when you want to rid of 'brief buffer without changing cursor position" + (use-local-map brief-mode-map) + (set (make-local-variable 'breif-old-size) 0) + (set (make-local-variable 'breif-old-tick) 0) + (set (make-local-variable 'brief-pos-list) nil) + (set (make-local-variable 'breif-source-file) nil) + (set (make-local-variable 'breif-source-buffer) nil) + (set (make-local-variable 'after-change-function) nil) + (set (make-local-variable 'after-change-functions) nil) + (setq mode-name "Brief" + major-mode 'brief-mode + truncate-lines t) + (auto-show-mode t) + (run-hooks 'brief-mode-hooks) + ) + +(defun brief-add-to-pos-list (beg method-string source-pos-list) +;;; add a new item to source-pos-list regarding the decreasing order of +;;; 1-st elements of items. Returns list: +;;; ( +;;; +;;; +;;; +;;; ) +;;; so (nth 1 result) < (nth 2 result) + (if (null source-pos-list) + (cons (list (cons beg method-string)) + '(1 1)) + (if (assoc beg source-pos-list) ;; - already added + (list source-pos-list 1 1) + (let* ((new-item (list (cons beg method-string))) + tmp-list) + (while (and source-pos-list + (< beg (car (car source-pos-list)))) + (setq tmp-list (cons (car source-pos-list) tmp-list) + source-pos-list (cdr source-pos-list)) + ) + (list (append (nreverse tmp-list) new-item source-pos-list) + (car (car source-pos-list)) + (car (car tmp-list)) + )) + )) + ) +(defun brief-add-checked-interval (beg end intervals) + ;; returns new intervals + (let* ((nb-of-intrvls (length intervals)) + (counter 0) + add-p + new-intervals);; intvl first-pt last-pt) + (while (and (<= counter nb-of-intrvls) + (not add-p)) + (let* ((first-pt (cdr (car new-intervals))) + (last-pt (car (car intervals))) + (first-coins (and first-pt + (= beg first-pt))) + (last-coins (and last-pt + (= end last-pt))) + ) + (if (not (or first-coins last-coins)) + (and (or (null first-pt) (< first-pt beg)) + (or (null last-pt) (> last-pt end)) + (setq add-p t)) + (if first-coins + (setq beg (car (car new-intervals)) + new-intervals (cdr new-intervals))) + (if last-coins + (setq end (cdr (car intervals)) + intervals (cdr intervals))) + (setq add-p t) + )) + + (if add-p + (setq new-intervals (cons (cons beg end) new-intervals)) + (setq new-intervals (cons (car intervals) new-intervals) + intervals (cdr intervals) + counter (1+ counter))) + ) + (append (nreverse new-intervals) intervals)) + ) + +(defun brief-fill-checked-intervals (before-beg beg after-beg elt-nb elts-list checked-intervals) +;;; returns updated checked-intervals. +;;; Define if the previous or\and current meths length rested the same + (let* ((elt (nth elt-nb elts-list)) + (prev-elt (if (> elt-nb 0) + (nth (1- elt-nb) elts-list))) + (next-elt (nth (1+ elt-nb) elts-list)) + + (before-dist (- beg (or before-beg 1))) + (expected-before-dist (- (nth 1 elt) + (or (nth 1 prev-elt) 1))) + (length-before-rest-p (= expected-before-dist before-dist)) + + (after-dist (- (or after-beg 0) + beg)) + (expected-after-dist (- (or (nth 1 next-elt) (point-max)) + (nth 1 elt))) + (length-after-rest-p (= expected-after-dist after-dist)) + ) + (if (or length-before-rest-p + length-after-rest-p) + ;; meth size not changed - save bounaries not to check later + (brief-add-checked-interval (if length-before-rest-p + before-beg beg) + (if length-after-rest-p + after-beg beg) + checked-intervals) + checked-intervals) + ) + ) +(defun brief-find-elt-in-interval (elt-nb elts-list beg end source-pos-list checked-intervals) + ;; returns cons: (source-pos-list . checked-intervals) + (goto-char beg) + (let* ((elt (nth elt-nb elts-list)) + (regexp (nth 2 elt))) + (if (re-search-forward regexp end t) + (let* ((method (match-string 0)) + (beg (match-beginning 0)) + (list-and-begs (brief-add-to-pos-list beg method source-pos-list)) + ) + (setq source-pos-list (car list-and-begs)) + (setq checked-intervals + (brief-fill-checked-intervals (nth 1 list-and-begs) ;; prev-beg + beg + (nth 2 list-and-begs) ;; next-beg + elt-nb + elts-list + checked-intervals)) + )) + (cons source-pos-list checked-intervals) + ) + ) + +(defun eap-regexp-for-method-string (meth-string) ;; for C++ + (let* ((len (length meth-string)) + (cur-pos 0) + result) ;; & * :: (,) + (while (< cur-pos len) + (let* (w-b w-e word elt) + (if (string-match "[0-9a-z_A-Z]+" meth-string cur-pos) + (setq word (match-string 0 meth-string) + w-b (match-beginning 0) + w-e (match-end 0)) + (setq w-b len)) + (while (< cur-pos w-b) + (setq elt (aref meth-string cur-pos)) + (cond ((or (= 32 elt) ;; whitespace - skip + (= 10 elt) ;; RET + (= 9 elt)) ;; TAB + nil) + ((= 47 elt) ;; c++-comment - add regexp + (setq result (concat result "[ \t\n]*//[^\n]*\n") + cur-pos (or (string-match "\n" meth-string cur-pos) + len))) + ((= 58 elt) ;; :: - don't separate + (setq result (concat result "[ \t\n]*::") + cur-pos (1+ cur-pos))) + ((= 42 elt) ;; * - quote regexp + (setq result (concat result "[ \t\n]*[*]"))) + (t ;; any other + (setq result (concat result "[ \t\n]*" + (substring meth-string cur-pos (1+ cur-pos)))))) + (setq cur-pos (1+ cur-pos))) + (and word + (= cur-pos w-b) + (setq result (concat result "[ \t\n]*" word) + cur-pos w-e)) + )) + (if (= 0 (string-match "\\[ \t\n\\][*]" result)) + (substring result 6) + result)) + ) +(defun breif-court-fichier-mouse2 (event) +;;; Move point to the position clicked on with the mouse-2 +;;; and returns the buffer visiting origin file with the +;;; point at first line of the clicked method. + (interactive "e") + (mouse-set-point event) + (breif-return-to-method)) +(defun breif-refresh-court-fichier () + ;; Updates info in brief-buffer + (interactive) + (set-buffer (find-file-noselect breif-source-file)) + (brief-show-only-method-heads 'refresh)) +(defun breif-return-to-method () + (interactive) + (let* ((posList brief-pos-list) + (home (point)) + (sourceBuffer (if (buffer-live-p breif-source-buffer) + breif-source-buffer + (if (not (file-exists-p breif-source-file)) + (eap-find-packed-file-internal + (file-name-nondirectory breif-source-file) breif-source-file) + (find-file-noselect breif-source-file)))) + ) + (if (not (buffer-live-p sourceBuffer)) + (message "Can't find file: %s" breif-source-file) + (while (and posList (< home (car (car posList)))) + (setq posList (cdr posList))) + (switch-to-buffer sourceBuffer) + (setq mark-active nil) + (goto-char (or (nth 1 (car posList)) (point-min))) + (recenter 1) + )) + ) +(defun brief-key() + (global-set-key [f3] 'brief-show-only-method-heads) + ) + +(provide 'brief) + + +;;;(defun dump-pos-list (&optional msg pos-list) +;;; (interactive) +;;; (if (boundp 'brief-pos-list) +;;; (let* ((text (if pos-list +;;; msg +;;; (concat msg " "))) +;;; (pos-list (or pos-list brief-pos-list)) +;;; elt) +;;; (eap-message "%s (%s)" (or text "") (buffer-name)) +;;; (while pos-list +;;; (setq elt (car pos-list) +;;; pos-list (cdr pos-list)) +;;; (condition-case nil +;;; (eap-message "%s %s %s" +;;; (car elt) +;;; (if (atom (nthcdr 1 elt)) +;;; (nthcdr 1 elt) +;;; (car (nthcdr 1 elt))) ;;(nth 1 elt) +;;; (or (atom (nthcdr 1 elt)) +;;; (if (car (nthcdr 2 elt));;(nth 2 elt) +;;; (eap-simplify-string (nth 2 elt) +;;; '(("\\([\n\t]\\|\\*\\)")("\\[ \\]" " "))) +;;; "" +;;; ))) +;;; (error (eap-message "ERROR: elt: %s list: %s" elt pos-list))) +;;; ) +;;; (eap-message "") +;;; ))) + diff --git a/src/WOKsite/public_el/buffer-navig.el b/src/WOKsite/public_el/buffer-navig.el new file mode 100644 index 0000000..9a68bee --- /dev/null +++ b/src/WOKsite/public_el/buffer-navig.el @@ -0,0 +1,109 @@ +;;;File :misc-tools.el +;;;Author :Edward AGAPOV +;;;Purpose : +;;;History :Tue Mar 14 12:27:39 2000 Edward AGAPOV Creation + +(eval-and-compile + (require 'shared) + ) + +(defun eap-goto-matching-paren () + "Move cursor to the matching parenthesis" + (interactive) + (let* ((match (eap-matching-paren))) + (if (not match) + (message "Matching parenthesis not found") + (if (and (interactive-p) + (not (pos-visible-in-window-p match))) + (eap-set-pos-at-line match (if (< (point) match) -2 2)) + t) + (goto-char match))) + ) +(defun eap-show-matching-paren () + "Make visible both current and it's matching parenthesis" + (interactive) + (let* ((match (eap-matching-paren)) + (pt (point)) + (split-window-keep-point nil) + (lines (if match (1+ (count-lines pt match))))) + (cond + ((null match) + (message "Matching parenthesis not found") + ) + ((pos-visible-in-window-p match) + (message "Matching parenthesis is already visible") + ) + ((and (< lines (frame-height)) + (let ((wh1 (window-height)) (wh2 0)) + (if (> lines (1+ wh1)) + (while (and (<= wh1 (+ 2 lines)) + (/= wh1 wh2)) ;; avoid infinite loop + (enlarge-window 1) + (sit-for 0) + (setq wh2 wh1 + wh1 (window-height)) + )) + (eap-set-pos-at-line match (if (< pt match) -1 0)) + (and (pos-visible-in-window-p pt) + (pos-visible-in-window-p match)) + )) + ) + (t ;; lines > frame-height + (delete-other-windows) + (if (> pt match) + (eap-set-pos-at-line pt -2) + (eap-set-pos-at-line pt 2)) + (split-window-vertically) + (sit-for 0) + (eap-other-window) + (if (> pt match) + (eap-set-pos-at-line match 2) + (eap-set-pos-at-line match -2)) + (goto-char match) + (sit-for 0) + (eap-other-window) + (goto-char pt) + ))) + ) +(defun eap-other-window (&optional toMiniBuffer) + "Move cursor to other window but not in mini-buffer. +With prexif argument move cursor in mini-buffer." + (interactive "P") + (if toMiniBuffer + (if (active-minibuffer-window) + (select-window (active-minibuffer-window)) + (message "Minibuffer in not active")) + (other-window 1) + (while (equal (selected-window) (minibuffer-window)) + (other-window 1))) + (if (fboundp 'eap-check-overwrite-state) + (eap-check-overwrite-state)) + ) +(defun eap-immediate-search (curWord &optional backward) + "Search for either the last copied text or \(with numeric argument\) current word" + (interactive "P") + (setq mark-active nil) + (if curWord (kill-new (current-word))) + (let* ((fox (current-kill 0)) + (hole (save-excursion + (if backward + (search-backward fox nil t) + (search-forward fox nil t))))) + (if (not hole) + (message "No more `%s' found" fox) + (or (pos-visible-in-window-p hole) (eap-set-pos-at-line hole)) + (goto-char hole))) + ) +(defun eap-immediate-search-backward (curWord) + "Same as `eap-immediate-search' but backward." + (interactive "P") + (eap-immediate-search curWord 'backward) + ) + +(defun buffer-navig-key () + (global-set-key [?\C-0] 'eap-show-matching-paren) + (global-set-key [?\C-9] 'eap-goto-matching-paren) + (global-set-key [f11] 'eap-immediate-search-backward) + (global-set-key [f12] 'eap-immediate-search) + ) +(provide 'buffer-navig) diff --git a/src/WOKsite/public_el/c++-mode.el b/src/WOKsite/public_el/c++-mode.el new file mode 100644 index 0000000..9cab8ae --- /dev/null +++ b/src/WOKsite/public_el/c++-mode.el @@ -0,0 +1,494 @@ +;; C++ code editing commands for Emacs +;; based on C mode +;; by Remi Lequette @ MDTV +;; +;; requires the C mode which is always loaded + +(load-library "cc-mode") + +(defvar c++-mode-abbrev-table nil + "Abbrev table in use in C++-mode buffers.") +(define-abbrev-table 'c++-mode-abbrev-table ()) + +(defvar c++-mode-map () + "Keymap used in C++ mode.") +;; this keymap is a copy of the C keymap +(if c++-mode-map + () + (setq c++-mode-map (copy-keymap c-mode-map))) +(define-key c++-mode-map "{" 'electric-c++-brace) +(define-key c++-mode-map "}" 'electric-c++-brace) +(define-key c++-mode-map ";" 'electric-c++-semi) +(define-key c++-mode-map ":" 'electric-c++-terminator) +(define-key c++-mode-map "\e\C-q" 'indent-c++-exp) +(define-key c++-mode-map "\t" 'c++-indent-command) +(define-key c++-mode-map "\M-k" 'c++-find-class) +(define-key c++-mode-map "\M-l" 'c++-find-c++) + + +(defvar c++-mode-syntax-table nil + "Syntax table in use in C++-mode buffers.") + +;; it is the C syntax table +(if c++-mode-syntax-table + () + (setq c++-mode-syntax-table c-mode-syntax-table) +) + +(defun c++-mode () + "Major mode for editing C++ code. +Expression and list commands understand all C brackets. +Tab indents for C code. +Comments are delimited with /* ... */. or // and newline +Created comments starts with //. +Paragraphs are separated by blank lines only. +Delete converts tabs to spaces as it moves back. +\\{c++-mode-map} +Variables controlling indentation style (like C) + c-tab-always-indent + Non-nil means TAB in C mode should always reindent the current line, + regardless of where in the line point is when the TAB command is used. + c-auto-newline + Non-nil means automatically newline before and after braces, + and after colons and semicolons, inserted in C code. + c-indent-level + Indentation of C statements within surrounding block. + The surrounding block's indentation is the indentation + of the line on which the open-brace appears. + c-continued-statement-offset + Extra indentation given to a substatement, such as the + then-clause of an if or body of a while. + c-continued-brace-offset + Extra indentation given to a brace that starts a substatement. + This is in addition to c-continued-statement-offset. + c-brace-offset + Extra indentation for line if it starts with an open brace. + c-brace-imaginary-offset + An open brace following other text is treated as if it were + this far to the right of the start of its line. + c-argdecl-indent + Indentation level of declarations of C function arguments. + c-label-offset + Extra indentation for line that is a label, or case or default. + +Settings for K&R and BSD indentation styles are + c-indent-level 5 8 + c-continued-statement-offset 5 8 + c-brace-offset -5 -8 + c-argdecl-indent 0 8 + c-label-offset -5 -8 + +Turning on C++ mode calls the value of the variable c++-mode-hook with no args, +if that value is non-nil." + (interactive) + (kill-all-local-variables) + (use-local-map c++-mode-map) + (setq major-mode 'c++-mode) + (setq mode-name "C++") + (setq local-abbrev-table c++-mode-abbrev-table) + (set-syntax-table c++-mode-syntax-table) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'c-indent-line) + (make-local-variable 'require-final-newline) + (setq require-final-newline t) + (make-local-variable 'comment-start) + (setq comment-start "// ") + (make-local-variable 'comment-end) + (setq comment-end "") + (make-local-variable 'comment-column) + (setq comment-column 32) + (make-local-variable 'comment-start-skip) + ;; beginning of comment is either two or more / then spaces + ;; or / then one or more * then spaces + (setq comment-start-skip "/[/*]+ *") + (make-local-variable 'comment-indent-hook) + (setq comment-indent-hook 'c++-comment-indent) + (make-local-variable 'parse-sexp-ignore-comments) + (setq parse-sexp-ignore-comments t) + (run-hooks 'c++-mode-hook)) + +;; This is used by indent-for-comment +;; to decide how much to indent a comment in C++ code +;; based on its context. +(defun c++-comment-indent () + (if + (looking-at "^/\\*\\|^//\\|^$") + 0 ;Existing comment at bol stays there. + ;; if comment preceded by spaces or tabs, indent as code + (if + (save-excursion + (beginning-of-line) + (looking-at "[ \t]+\\(/\\*\\|//\\|$\\)")) + (calculate-c-indent) + (save-excursion + (skip-chars-backward " \t") + (max (1+ (current-column)) ;Else indent at comment column + comment-column))))) ; except leave at least one space. + + +(defun electric-c++-brace (arg) + "Insert character and correct line's indentation." + (interactive "P") + (let (insertpos) + (if (and (not arg) + (eolp) + (or (save-excursion + (skip-chars-backward " \t") + (bolp)) + (if c-auto-newline (progn (c++-indent-line) (newline) t) nil))) + (progn + (insert last-command-char) + (c++-indent-line) + (if c-auto-newline + (progn + (newline) + ;; (newline) may have done auto-fill + (setq insertpos (- (point) 2)) + (c++-indent-line))) + (save-excursion + (if insertpos (goto-char (1+ insertpos))) + (delete-char -1)))) + (if insertpos + (save-excursion + (goto-char insertpos) + (self-insert-command (prefix-numeric-value arg))) + (self-insert-command (prefix-numeric-value arg))))) + +(defun electric-c++-semi (arg) + "Insert character and correct line's indentation." + (interactive "P") + (if c-auto-newline + (electric-c++-terminator arg) + (self-insert-command (prefix-numeric-value arg)))) + +(defun electric-c++-terminator (arg) + "Insert character and correct line's indentation." + (interactive "P") + (let (insertpos (end (point))) + (if (and (not arg) (eolp) + (not (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (or (= (following-char) ?#) + ;; Colon is special only after a label, or case .... + ;; So quickly rule out most other uses of colon + ;; and do no indentation for them. + (and (eq last-command-char ?:) + (not (looking-at "case[ \t]")) + (save-excursion + (forward-word 1) + (skip-chars-forward " \t") + (< (point) end))) + (progn + (beginning-of-defun) + (let ((pps (parse-partial-sexp (point) end))) + (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))))) + (progn + (insert last-command-char) + (c++-indent-line) + (and c-auto-newline + (not (c-inside-parens-p)) + (progn + (newline) + (setq insertpos (- (point) 2)) + (c++-indent-line))) + (save-excursion + (if insertpos (goto-char (1+ insertpos))) + (delete-char -1)))) + (if insertpos + (save-excursion + (goto-char insertpos) + (self-insert-command (prefix-numeric-value arg))) + (self-insert-command (prefix-numeric-value arg))))) + + +(defun c++-indent-command (&optional whole-exp) + (interactive "P") + "Indent current line as C++ code, or in some cases insert a tab character. +If c-tab-always-indent is non-nil (the default), always indent current line. +Otherwise, indent the current line only if point is at the left margin +or in the line's indentation; otherwise insert a tab. + +A numeric argument, regardless of its value, +means indent rigidly all the lines of the expression starting after point +so that this line becomes properly indented. +The relative indentation among the lines of the expression are preserved." + (if whole-exp + ;; If arg, always indent this line as C++ + ;; and shift remaining lines of expression the same amount. + (let ((shift-amt (c++-indent-line)) + beg end) + (save-excursion + (if c-tab-always-indent + (beginning-of-line)) + (setq beg (point)) + (forward-sexp 1) + (setq end (point)) + (goto-char beg) + (forward-line 1) + (setq beg (point))) + (if (> end beg) + (indent-code-rigidly beg end shift-amt "#"))) + (if (and (not c-tab-always-indent) + (save-excursion + (skip-chars-backward " \t") + (not (bolp)))) + (insert-tab) + (c++-indent-line)))) + +(defun c++-indent-line () + "Indent current line as C++ code. +Return the amount the indentation changed by." + (let ((indent (calculate-c++-indent nil)) + beg shift-amt + (case-fold-search nil) + (pos (- (point-max) (point)))) + (beginning-of-line) + (setq beg (point)) + (cond ((eq indent nil) + (setq indent (current-indentation))) + ((eq indent t) + (setq indent (calculate-c-indent-within-comment))) + ((looking-at "[ \t]*#") + (setq indent 0)) + (t + (skip-chars-forward " \t") + (if (listp indent) (setq indent (car indent))) + (cond ((or (looking-at "case[ \t]") + (and (looking-at "[A-Za-z]") + (save-excursion + (forward-sexp 1) + (looking-at ":[^:]")))) + (setq indent (max 1 (+ indent c-label-offset)))) + ((and (looking-at "else\\b") + (not (looking-at "else\\s_"))) + (setq indent (save-excursion + (c-backward-to-start-of-if) + (current-indentation)))) + ((= (following-char) ?}) + (setq indent (- indent c-indent-level))) + ((= (following-char) ?{) + (setq indent (+ indent c-brace-offset)))))) + (skip-chars-forward " \t") + (setq shift-amt (- indent (current-column))) + (if (zerop shift-amt) + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + (delete-region beg (point)) + (indent-to indent) + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))) + shift-amt)) + +(defun calculate-c++-indent (&optional parse-start) + "Return appropriate indentation for current line as C++ code. +In usual case returns an integer: the column to indent to. +Returns nil if line starts inside a string, t if in a comment." + (save-excursion + (beginning-of-line) + (let ((indent-point (point)) + (case-fold-search nil) + state + containing-sexp) + (if parse-start + (goto-char parse-start) + (beginning-of-defun)) + (while (< (point) indent-point) + (setq parse-start (point)) + (setq state (parse-partial-sexp (point) indent-point 0)) + (setq containing-sexp (car (cdr state)))) + (cond ((or (nth 3 state) (nth 4 state)) + ;; return nil or t if should not change this line + (nth 4 state)) + ((null containing-sexp) + ;; Line is at top level. May be data or function definition, + ;; or may be function argument declaration. + ;; Indent like the previous top level line + ;; unless that ends in a closeparen without semicolon, + ;; in which case this line is the first argument decl. + (goto-char indent-point) + (skip-chars-forward " \t") + (if (= (following-char) ?{) + 0 ; Unless it starts a function body + (c++-backward-to-noncomment (or parse-start (point-min))) + ;; Look at previous line that's at column 0 + ;; to determine whether we are in top-level decls + ;; or function's arg decls. Set basic-indent accordinglu. + (let ((basic-indent + (save-excursion + (re-search-backward "^[^ \^L\t\n#]" nil 'move) + (if (and (looking-at "\\sw\\|\\s_") + (looking-at ".*(") + (progn + (goto-char (1- (match-end 0))) + (forward-sexp 1) + (and (< (point) indent-point) + (not (memq (following-char) + '(?\, ?\;)))))) + c-argdecl-indent 0)))) + ;; Now add a little if this is a continuation line. + (+ basic-indent (if (or (bobp) + (memq (preceding-char) '(?\) ?\; ?\}))) + 0 c-continued-statement-offset))))) + ((/= (char-after containing-sexp) ?{) + ;; line is expression, not statement: + ;; indent to just after the surrounding open. + (goto-char (1+ containing-sexp)) + (current-column)) + (t + ;; Statement level. Is it a continuation or a new statement? + ;; Find previous non-comment character. + (goto-char indent-point) + (c++-backward-to-noncomment containing-sexp) + ;; Back up over label lines, since they don't + ;; affect whether our line is a continuation. + (while (or (eq (preceding-char) ?\,) + (and (eq (preceding-char) ?:) + (or (eq (char-after (- (point) 2)) ?\') + (memq (char-syntax (char-after (- (point) 2))) + '(?w ?_))))) + (if (eq (preceding-char) ?\,) + (c-backward-to-start-of-continued-exp containing-sexp)) + (beginning-of-line) + (c++-backward-to-noncomment containing-sexp)) + ;; Now we get the answer. + (if (not (memq (preceding-char) '(nil ?\, ?\; ?\} ?\{))) + ;; This line is continuation of preceding line's statement; + ;; indent c-continued-statement-offset more than the + ;; previous line of the statement. + (progn + (c-backward-to-start-of-continued-exp containing-sexp) + (+ c-continued-statement-offset (current-column) + (if (save-excursion (goto-char indent-point) + (skip-chars-forward " \t") + (eq (following-char) ?{)) + c-continued-brace-offset 0))) + ;; This line starts a new statement. + ;; Position following last unclosed open. + (goto-char containing-sexp) + ;; Is line first statement after an open-brace? + (or + ;; If no, find that first statement and indent like it. + (save-excursion + (forward-char 1) + (let ((colon-line-end 0)) + (while (progn (skip-chars-forward " \t\n") + (looking-at "#\\|/\\*\\|case[ \t\n].*:\\|[a-zA-Z0-9_$]*:\\|//")) + ;; Skip over comments and labels following openbrace. + (cond ((= (following-char) ?\#) + (forward-line 1)) + ((looking-at "/\\*") + (forward-char 2) + (search-forward "*/" nil 'move)) + ((looking-at "//") + (end-of-line)) + ;; case or label: + (t + (save-excursion (end-of-line) + (setq colon-line-end (point))) + (search-forward ":")))) + ;; The first following code counts + ;; if it is before the line we want to indent. + (and (< (point) indent-point) + (if (> colon-line-end (point)) + (- (current-indentation) c-label-offset) + (current-column))))) + ;; If no previous statement, + ;; indent it relative to line brace is on. + ;; For open brace in column zero, don't let statement + ;; start there too. If c-indent-level is zero, + ;; use c-brace-offset + c-continued-statement-offset instead. + ;; For open-braces not the first thing in a line, + ;; add in c-brace-imaginary-offset. + (+ (if (and (bolp) (zerop c-indent-level)) + (+ c-brace-offset c-continued-statement-offset) + c-indent-level) + ;; Move back over whitespace before the openbrace. + ;; If openbrace is not first nonwhite thing on the line, + ;; add the c-brace-imaginary-offset. + (progn (skip-chars-backward " \t") + (if (bolp) 0 c-brace-imaginary-offset)) + ;; If the openbrace is preceded by a parenthesized exp, + ;; move to the beginning of that; + ;; possibly a different line + (progn + (if (eq (preceding-char) ?\)) + (forward-sexp -1)) + ;; Get initial indentation of the line we are on. + (current-indentation)))))))))) + + +(defun c++-backward-to-noncomment (lim) + (let (opoint stop) + (while (not stop) + (skip-chars-backward " \t\n\f" lim) + (setq opoint (point)) + (cond + ((and (>= (point) (+ 2 lim)) + (save-excursion + (forward-char -2) + (looking-at "\\*/"))) + (search-backward "/*" lim 'move)) + ((search-backward "//" + (max lim (save-excursion + (beginning-of-line) + (point))) + t)) + (t + (beginning-of-line) + (skip-chars-forward " \t") + (setq stop (or (not (looking-at "#")) (<= (point) lim))) + (if stop (goto-char opoint) + (beginning-of-line))))))) + + + +;; to find class in the buffer + +(defun c++-find-class () + "Find the cdl file for the class in the buffer at current point" + (interactive) + (let (class package) + (save-excursion + (if (eq (point) (point-max)) () (forward-char 1)) + (forward-word -1) + (while (eq 95 (char-after (1- (point)))) (forward-word -1)) + (if (looking-at "\\(\\w+\\)_\\(\\w+\\)") + (setq + package (buffer-substring (match-beginning 1) (match-end 1)) + class (buffer-substring (match-beginning 2) (match-end 2))) + (if (looking-at "\\(\\w+\\)") + (setq package (buffer-substring (match-beginning 1) (match-end 1)))))) + (if class + (set-buffer (find-file + (car (wok-command (format "woklocate -p %s:source:%s_%s.cdl\n" package package class))))) + (set-buffer (find-file + (car (wok-command (format "woklocate -p %s:source:%s.cdl\n" package package)))))))) + +(defun c++-find-c++ () + "Find the c++ file for the class in the buffer at current point" + (interactive) + (let (class package) + (save-excursion + (if (eq (point) (point-max)) () (forward-char 1)) + (forward-word -1) + (while (eq 95 (char-after (1- (point)))) (forward-word -1)) + (if (looking-at "\\(\\w+\\)_\\(\\w+\\)") + (setq + package (buffer-substring (match-beginning 1) (match-end 1)) + class (buffer-substring (match-beginning 2) (match-end 2))) + (if (looking-at "\\(\\w+\\)") + (setq package (buffer-substring (match-beginning 1) (match-end 1)))))) + (if class + (set-buffer (find-file + (car (wok-command (format "woklocate -p %s:source:%s_%s.cxx\n" package package class))))) + (set-buffer (find-file + (car (wok-command (format "woklocate -p %s:source:%s.cxx\n" package package)))))))) diff --git a/src/WOKsite/public_el/cdl-mode.el b/src/WOKsite/public_el/cdl-mode.el new file mode 100644 index 0000000..e682ba5 --- /dev/null +++ b/src/WOKsite/public_el/cdl-mode.el @@ -0,0 +1,610 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; CDL editing support package in GNUlisp. v1.1 +; Author: Remi Lequette @ Matra-Datavision August 1990. +; +; Update: (FID 06/02/96) +; new CDL keywords; +; quicker working. +; Update: +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; +; CDL (Class Description Language) is used internally at Matra-Datavision +; for Object Oriented software specifications +; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Features of this mode are : +; +; simple indentation scheme based on tabulations +; tabulation value is given by the variable cdl-indent +; +; automatic insertion of CDL keywords with templates : +; class, package, etc.. +; +; for comment rubriques C-c C-r there is an automatic completion on rubrique +; names, see cdl-rubrique-table +; +; special behaviour inside comments +; +; automatic fontifying on CDL keywords. +; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar cdl-rubrique-table nil + + "Completion table for CDL rubriques") + +(setq + cdl-rubrique-table + '( + ("Purpose: ") + ("Version: ") + ("Include: ") + ("Category: ") + ("Example: ") + ("Le Lisp: ") + ("Keywords: ") + ("Warning: ") + ("References: ") + ("Overview: ") + ("C++: ") + ("C++: inline") + ("C++: alias ") + ("Level: Public ") + ("Level: Advanced ") + ("Level: Internal ") + ("See Also: "))) + +(defvar cdl-structure-table + '( + ("class" . cdl-new-class) + ("package" . cdl-new-package) + ("rubrique" . cdl-new-rubrique) + ("buffer" . cdl-new-buffer) + ("enumeration" . cdl-new-enumeration) + ("exception" . cdl-new-exception) + ) + "*Structures in CDL, name followed by function to insert structure.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; CDL keywords list features for fontifying. +;; +;; Please, keep the CDL keyword lists in alphabetic order! +;; So it is much easier to verify or update them. Thanks! +;; Revision: FID 06/02/96 +;; Addition of many forgotten keywords (18); +;; Addition of next CDL version keywords (8); +;; New regexps for a quicker working. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar cdl-default-keywords nil + "*Default list of keywords for font-lock") + +(defvar cdl-default-public-keywords nil + "*Default sub-list of public access CDL keywords") + +(defvar cdl-default-private-keywords nil + "*Default sub-list of restricted access CDL keywords") + +(defvar cdl-rubrique-face 'bold-italic + "*Default CDL rubrique font") + +;; Public access keywords; for everybody +(setq cdl-default-public-keywords + ( concat + "a\\(lias\\|ny\\|s\\)" + "\\|class" + "\\|deferred" + "\\|e\\(n\\(d\\|gine\\|umeration\\)" + "\\|x\\(ception\\|e\\(cfile\\|cutable\\)\\|ternal\\)\\)" + "\\|f\\(ields\\|ortran\\|r\\(iends\\|om\\)\\)" + "\\|generic" + "\\|i\\(m\\(mutable\\|ported\\)" + "\\|n\\(\\|herits\\|stantiates\\|terface\\)" + "\\|s\\)" + "\\|li\\(brary\\|ke\\)" + "\\|m\\(e\\|utable\\|yclass\\)" + "\\|o\\(bject\\|ut\\)" + "\\|p\\(ackage\\|ointer\\|r\\(i\\(mitive\\|vate\\)\\|otected\\)\\)" + "\\|r\\(aises\\|e\\(defined\\|turns\\)\\)" + "\\|s\\(chema\\|tatic\\)" + "\\|to" + "\\|uses" + "\\|virtual" + ) + ) + +;; Restricted access keywords; for internal and specialized use only. +(setq cdl-default-private-keywords + ( concat + "c" + "\\|ex\\(ecfile\\|ternal\\)" + "\\|fortran" + "\\|library" + "\\|object" + "\\|primitive" + ) + ) + + +;; The complete formed CDL keyword regexp now! +(setq cdl-default-keywords + (list + + (concat + "\\<\\(" + cdl-default-public-keywords + "\\|" + cdl-default-private-keywords + "\\)\\>") + + '("c[+][+]" 0 font-lock-keyword-face t) + '("---.*:" 0 cdl-rubrique-face t)) + ) + +(defvar cdl-mode-syntax-table nil + "*Syntax table in use in CDL mode buffers.") + +(let ((table (make-syntax-table))) + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) + (modify-syntax-entry ?$ "." table) + (modify-syntax-entry ?* "." table) + (modify-syntax-entry ?/ "." table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?\& "." table) + (modify-syntax-entry ?\| "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?\[ "." table) + (modify-syntax-entry ?\] "." table) + (modify-syntax-entry ?\{ "." table) + (modify-syntax-entry ?\} "." table) + (modify-syntax-entry ?. "." table) + (modify-syntax-entry ?\\ "/" table) + (modify-syntax-entry ?: "." table) + (modify-syntax-entry ?\; "." table) + (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?- ". 12" table) + (modify-syntax-entry ?\n ">" table) + (setq cdl-mode-syntax-table table)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar cdl-cc-map nil + "Keymap used in CDL mode for Control-C commands.") +;; keys definition +(let ((map (make-sparse-keymap))) + (define-key map "e" 'cdl-comment-end) + (define-key map "t" 'cdl-tabsize) + (define-key map "s" 'cdl-structure) + (define-key map "f" 'cdl-fill-mode) + (define-key map "\C-c" 'cdl-new-class) + (define-key map "\C-r" 'cdl-new-rubrique) + (define-key map "\C-p" 'cdl-new-package) + (define-key map "\C-b" 'cdl-new-buffer) + (define-key map "\C-e" 'cdl-new-enumeration) + (define-key map "\C-x" 'cdl-new-exception) + (setq cdl-cc-map map)) + +(defvar cdl-mode-map nil + "Keymap used in CDL mode.") +;; keys definition +(let ((map (make-sparse-keymap))) + (define-key map "\C-m" 'cdl-newline) + (define-key map "\M-\C-m" 'cdl-raw-newline) + (define-key map "\C-?" 'backward-delete-char-untabify) + (define-key map "\C-i" 'cdl-tab) + (define-key map "\M-\C-i" 'cdl-untab) + (define-key map "\M-p" 'cdl-insert-packname) + (define-key map "\M-c" 'cdl-insert-classname) + (define-key map "\M-a" 'cdl-insert-from) + (define-key map "\e\q" 'cdl-comment-fill) + (define-key map "\C-c" cdl-cc-map) + (setq cdl-mode-map map)) + +(defvar cdl-indent 4 "*Value is the number of columns to indent in CDL Mode.") + +(defvar cdl-mode-abbrev-table nil + "Abbrev table in use in CDL-mode buffers.") +(define-abbrev-table 'cdl-mode-abbrev-table ()) + +(defun cdl-mode () +"This is a mode intended to support CDL specifications writing + +Variable cdl-indent controls the number of spaces for indent/undent. +Function cdl-new-buffer is called on empty buffers and can be redefined. + +\\{cdl-mode-map} +" + (interactive) + (kill-all-local-variables) + (use-local-map cdl-mode-map) + (setq major-mode 'cdl-mode) + (setq mode-name "CDL") + (setq local-abbrev-table cdl-mode-abbrev-table) + (make-local-variable 'auto-fill-function) + (setq auto-fill-function nil) + (make-local-variable 'cdl-auto-fill-function) + (setq cdl-auto-fill-function 'cdl-comment-do-auto-fill) + (make-local-variable 'comment-column) + (setq comment-column 41) + (make-local-variable 'end-comment-column) + (setq end-comment-column 72) + (set-syntax-table cdl-mode-syntax-table) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + (make-local-variable 'require-final-newline) + (setq require-final-newline t) + (make-local-variable 'comment-start) + (setq comment-start "--") + (make-local-variable 'comment-end) + (setq comment-end "\n") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "--+ *") + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'c-comment-indent) + (make-local-variable 'parse-sexp-ignore-comments) + (setq parse-sexp-ignore-comments t) +;; (make-local-variable 'package) +;; (make-local-variable 'class) + (make-local-variable 'cdl-mode-package) + (make-local-variable 'cdl-mode-class) + (make-local-variable 'font-lock-mode-hook) + (setq font-lock-mode-hook + '(lambda () (setq font-lock-keywords cdl-default-keywords))) + (setq cdl-mode-package (substring (buffer-name) 0 -4)) + (let ((i (string-match "_" cdl-mode-package))) + (if i (setq + cdl-mode-class (substring cdl-mode-package (1+ i)) + cdl-mode-package (substring cdl-mode-package 0 i)) + (setq cdl-mode-class nil))) + (if (zerop (buffer-size)) + (cdl-new-buffer)) + (run-hooks 'cdl-mode-hook)) + +(defun cdl-tabsize (s) + "changes spacing used for indentation. Reads spacing from minibuffer." + (interactive "nnew indentation spacing: ") + (setq cdl-indent s)) + +(defun cdl-newline () + "Open a new line with indent and comment if necessary." + (interactive) + (if (cdl-in-comment) + (insert ?\n (cdl-comment-current-fill)) + (cdl-raw-newline))) + +(defun cdl-raw-newline () + "Start new line and indent to current tab stop." + (interactive) + (let ((cdl-cc (current-indentation))) + (newline) + (if (looking-at "^[ \t]*$") + (progn + (indent-to cdl-cc) + (if (looking-at "[ \t]") + (kill-line)))))) + +(defun cdl-tab () + "Indent to next tab stop." + (interactive) + (indent-to (* (1+ (/ (current-indentation) cdl-indent)) cdl-indent))) + +(defun cdl-untab () + "Delete backwards to previous tab stop." + (interactive) + (backward-delete-char-untabify cdl-indent nil)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; here we define the CDL comment commands +;; used to fill the comments +;; this only for comments alone on a line ... +;; + +;; the basic test, are we inside a comment +(defun cdl-in-comment () + "Test if we are in a comment line." + (save-excursion + (beginning-of-line) + (looking-at "^[ \t]*--"))) + +;; find the current fill prefix +;; generally from the beginning of the line to the first non blank +;; skipping the -- +;; exception if the line is a rubrique, the rubrique title is skipped +;; a rubrique title is of the form ---xxxxx: + +(defun cdl-comment-current-fill () + (save-excursion + (let (prefix) + (beginning-of-line) + (looking-at "^[ \t]*---*[^ \t]*[ \t]*") + (setq prefix (buffer-substring (match-beginning 0) (match-end 0))) + ;; clear non dash caracters in prefix + (let ((clean-prefix "") + (sp 0) + c + (size (length prefix))) + (setq c (substring prefix 0 1)) + (while (not (string= c "-")) + (setq clean-prefix (concat clean-prefix c)) + (setq sp (1+ sp)) + (setq c (substring prefix sp (1+ sp)))) + (setq clean-prefix (concat clean-prefix "--")) + (setq sp (+ sp 2)) + (while (< sp size) + (setq c (substring prefix sp (1+ sp))) + (setq clean-prefix + (concat clean-prefix (if (string= c "\t") c " "))) + (setq sp (1+ sp))) + clean-prefix)))) + + +;; toggles the auto-fill mode +;; +(defun cdl-fill-mode (arg) + "Toggle cdl auto-fill-mode, fills only in comments" + (interactive "P") + (auto-fill-mode arg) + (if auto-fill-function + (setq auto-fill-function + cdl-auto-fill-function))) + +;; used in auto-fill mode to fill-in comments +(defun cdl-comment-do-auto-fill () + "Performs auto-fill in comments" + (if (cdl-in-comment) + (let ((opoint (point))) + (save-excursion + (move-to-column (1+ fill-column)) + (skip-chars-backward "^ \t\n") + (if (bolp) + (re-search-forward "[ \t]" opoint t)) + (if (save-excursion + (let (is-begin is-end) + (setq is-end (eolp)) + (skip-chars-backward " \t") + (setq is-begin (bolp)) + (and (not is-begin) (not is-end)))) + ;; wrap the line + (progn + (setq fill-prefix (cdl-comment-current-fill)) + (insert ?\n fill-prefix))))))) + +;; fill command +;; narrow the buffer to the surrounding indented comment before filling it +(defun cdl-comment-fill (arg) + "fill current comment paragraph." + (interactive "P") + (if (cdl-in-comment) + (let (is-bolp fill-prefix) + (setq is-bolp (bolp)) + (save-excursion + (let (beg end) + (setq beg + (progn + (while (and + (if (bobp) + nil + (forward-line -1) t) + (if (and + (cdl-in-comment) + (progn + (beginning-of-line) + (not (looking-at "^[ \t]*--[ \t]*$")))) + t + (forward-line 1) nil))) + (beginning-of-line) + (setq fill-prefix (cdl-comment-current-fill)) + (point))) + (setq end + (progn + (while (and + (if (progn (end-of-line) (eobp)) + nil + (forward-line 1) t) + (if (and + (cdl-in-comment) + (progn + (beginning-of-line) + (not (looking-at "^[ \t]*--[ \t]*$")))) + t + (forward-line -1) nil))) + (if (eobp) + (insert ?\n) + (forward-line 1) + (beginning-of-line)) + (point))) + (fill-region beg end arg))) + (if (and (not is-bolp) (bolp)) + (search-forward fill-prefix))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; following functions are used to insert structures +;;;; they have a name like cdl-new-structname +;;;; an entry ("structname" . cdl-new-structname) should +;;;; be entered in cdl-structure-table +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun cdl-structure () + "Insert a CDL structure prompted in a list." + (interactive) + (let ((name + (completing-read "structure to insert : " + cdl-structure-table + nil t))) + (if name + (funcall (cdr (assoc name cdl-structure-table)))))) + + +(defun cdl-new-class () + "Insert a class declaration, name is prompted." + (interactive) + (let (p + (name (read-from-minibuffer + "class name : " cdl-mode-class))) + (end-of-line) + (insert "\nclass " name " from ") + (if cdl-mode-package (insert cdl-mode-package " ")) + (setq p (point)) + (insert "\n\n\t---Purpose: ") + (insert "\n\nuses") + (insert "\n\nraises") + (insert "\n\nis") + (insert "\n\nfields") + (insert "\n\nend " name ";\n") + (goto-char p))) + +(defun cdl-new-package () + "Insert a package declaration, name is prompted." + (interactive) + (let (p + (name (read-from-minibuffer + "package name :" cdl-mode-package))) + (end-of-line) + (insert "\npackage " name " ") + (setq p (point)) + (insert "\n\n\t---Purpose: ") + (insert "\n\nuses") + (insert "\n\nis") + (insert "\n\nend " name ";\n") + (goto-char p))) + +(defun cdl-new-buffer () + "Insert a header for each empty CDL buffer " + (interactive) + (insert "-- File: " (buffer-name)) + (insert "\n-- Created: " (format-time-string "%d.%m.%y %H:%M:%S")) + (insert "\n-- Author: " (concat (user-login-name) "@" (system-name))) + (insert "\n---Copyright: Open CASCADE " (format-time-string "%Y") "\n") + ) + +(defun cdl-new-rubrique () + "Insert a rubrique comment, prompt with completion" + (interactive) + (let + ((name (completing-read "Rubrique name:" cdl-rubrique-table nil t)) + (prefix)) + (beginning-of-line) + (indent-to (current-indentation)) + (insert "---" name ) + ;; delete blank and tabs + (delete-region (point) (save-excursion + (skip-chars-forward " \t" (buffer-size)) + (point))))) + +(defun cdl-new-enumeration () + "Insert an enumeration declaration, name is prompted." + (interactive) + (let (p + (name (read-from-minibuffer "enumeration name :"))) + (end-of-line) + (insert "\nenumeration " name " is ") + (insert "\n\t---Purpose: ") + (setq p (point)) + (insert "\n\nend " name ";\n") + (goto-char p))) + +(defun cdl-new-exception () + "Insert an exception declaration, name is prompted." + (interactive) + (let (p + (name (read-from-minibuffer "exception name :"))) + (insert "\texception " name " inherits ") + (setq p (point)) + (insert ";\n") + (goto-char p))) + + + +;; to find the class whose name is in buffer + +;;(defun cdl-find-class () +;; "Find the cdl file of the class near point in other window." +;; (interactive) +;; (let ((class nil) (notfound t) pos) +;; (save-excursion +;; (forward-char 1) +;; (forward-word -1) +;; (if (looking-at "from ") +;; (setq notfound nil) +;; (forward-word -1) +;; (if (looking-at "from ") +;; (setq notfound nil) +;; (forward-word 3) +;; (forward-word -1) +;; (if (looking-at "from ") +;; (setq notfound nil)))) +;; (if notfound +;; () +;; (forward-word -1) +;; (setq pos (point)) +;; (forward-word 3) +;; (setq class (buffer-substring pos (point))) +;; )) +;; (if class (wok-find-cdl class)))) + + +(defun cdl-find-class () + "Find the cdl file of the class near point in other window." + (interactive) + (let ((class nil) (notfound t) pos) + (save-excursion + (forward-char 1) + (forward-word -1) + (if (looking-at "from ") + (setq notfound nil) + (forward-word -1) + (if (looking-at "from ") + (setq notfound nil) + (forward-word 3) + (forward-word -1) + (if (looking-at "from ") + (setq notfound nil)))) + (if notfound + () + (forward-word -1) + (setq pos (point)) + (forward-word 1) + (setq class (buffer-substring pos (point))) + (forward-word 2) + (forward-word -1) + (setq pos (point)) + (forward-word 1) + (setq cdl-mode-package (buffer-substring pos (point))) + )) + (if class + (set-buffer (find-file + (car (wok-command (format "woklocate -p %s:source:%s_%s.cdl\n" + cdl-mode-package cdl-mode-package class))))) + (set-buffer (find-file + (car (wok-command (format "woklocate -p %s:source:%s.cdl\n" + cdl-mode-package cdl-mode-package))))))) + ) +;; to insert in the file + +(defun cdl-insert-classname () + "Insert the current class name at point." + (interactive) + (insert cdl-mode-class)) + +(defun cdl-insert-packname () + "Insert the current package name at point." + (interactive) + (insert cdl-mode-package)) + +(defun cdl-insert-from () + "Insert \"class from package\" at point." + (interactive) + (insert cdl-mode-class " from " cdl-mode-package)) + diff --git a/src/WOKsite/public_el/class-info.el b/src/WOKsite/public_el/class-info.el new file mode 100644 index 0000000..901bc46 --- /dev/null +++ b/src/WOKsite/public_el/class-info.el @@ -0,0 +1,331 @@ +;;; class-info.el --- some info on C++ class contained in Cascade Software Factory + +;;;Author : Edward AGAPOV +;;;History : Thu Oct 11 2001 Edward AGAPOV Creation + +;;; Commentary: + +;; Prerequisite: CSF environment to be set \(see 'eap-csf library) + +;; Useful entries: +;; * eap-all-acceseble-fields +;; * eap-all-included +;; * eap-pearent +;; * eap-walk-over-inherited + +(require 'eap-csf) + +(defun eap-is-definition (file) + (string-match "[.][gc]x*" file) + ) +(defun eap-all-acceseble-fields (type &optional type-names-p) + "Return a list of all own and accessible inherited fields for class TYPE. +If TYPE-NAMES-P, return a list of field types." + (let* (not-private-p res-list) + (save-excursion + (eap-walk-over-inherited + '(lambda() + ;;(message "%s" buffer-file-name) + (setq res-list + (append res-list + (if (string-match "[.]cdl$" buffer-file-name) + (eap-all-fields-in-cdl type-names-p not-private-p) + (eap-all-fields-in-hxx type-names-p not-private-p)))) + (setq not-private-p t) + ) ;; BODY + type ;; SOURCE + t ;; THROUGHALL + t ;; DECLARATION-P + ) + res-list)) + ) + +(defun eap-all-fields-in-cdl (&optional type-names-p not-private) + "Return list of fields found in visited cdl file. +If TYPE-NAMES-P, return a list of field types. +NOT-PRIVATE makes ignore private fields." + (goto-char (point-max)) + (re-search-backward "^\\s *fields\\>" nil t) + (let* ((field-re (concat "^\\s *\\([,\t a-z0-9]+,[ \t]*\\)?\\(\\w+\\)\\s *:" + "\\s *\\(\\w+\\(\\s +from\\s +\\w+\\)?\\)")) + (modif-re "\\(\\s +[^;]+\\|\\s *;\\)") + (re (concat field-re modif-re)) + res-list res type-complete-p modificator rest) + (while (re-search-forward re nil t) + (setq type-complete-p (match-end 4)) + (setq modificator (eap-match-string 5)) + (setq rest (match-string 1)) + (setq res (if type-names-p (eap-match-string 3)(eap-match-string 2))) + (if not-private + (setq modificator (eap-replace-all "--[^\n]+" " " modificator))) + (if (and not-private + (not (string-match "[^a-z0-9]is[ \t\n]+\\(protected\\|public\\)" modificator))) + (setq res nil) + (if type-names-p + ;; find field type + (if type-complete-p + (setq res (eap-cpp-style (eap-replace-all "[\t\n]" " " res))) + (setq res (eap-find-pack-for-class res))) + ;; get rest fields + (let (start) + (while (string-match "\\w+" (or rest "") start) + (setq res-list (cons (eap-match-string 0 rest) res-list)) + (setq start (match-end 0)) + )) + )) + (if res + (setq res-list (cons res res-list))) + ) + res-list) + ) +(defun eap-all-fields-in-hxx (&optional type-names-p not-private) + "Return list of fields found in visited hxx file. +If TYPE-NAMES-P, return a list of field types. +NOT-PRIVATE makes ignore private fields." + (goto-char 1) + (let* ((re "^\\s *\\(Handle\\s *[(_]\\s *\\)?\\([_a-z0-9]+\\)[*&) ]+\\([_a-z0-9]+\\)\\s *;") + (cl (eap-class-name)) + (beg (re-search-forward (format "^\\s *class\\s +%s\\>" cl) nil t)) + res-list res type handle-p) + (while (re-search-forward re nil t) + (setq handle-p (match-end 1)) + (setq type (eap-match-string 2)) + (setq res (if type-names-p type (eap-match-string 3))) + (or (string-match "^\\(class\\|return\\)" type) + (and not-private + (save-excursion + ;; check private + (re-search-backward "^\\s *\\(private\\|protected\\|public\\)\\s *:" beg t)) + (string-match "private" (eap-match-string 0))) + (setq res-list (cons res res-list))) + ) + res-list) + ) +(defun eap-all-included () + "Return list of types included into current one. +For C++ class file recursively collects included headers. +For CDL file return classes from 'used clause" + (if (string-match "[.]cdl" buffer-file-name) + (eap-all-included-in-cdl) + (eap-all-included-in-cpp) + )) +(defun eap-all-included-in-cpp (&optional avoid-list msg) + "Return list of classes included in current C++ file excluding ones in AVOID-LIST. +If MSG, print message MSG plus visited include file name" + (save-excursion + (let (res-list cls ext) + (goto-char 1) + (while (re-search-forward + "^[ \t]*#[ \t]*include[ \t][<\"]\\([_a-z0-9]+\\)[.]\\([hij]x*\\)[>\"]" nil t) + (setq cls (eap-match-string 1) + ext (eap-match-string 2)) + (and (if (member cls avoid-list) + (string-match "[ij]xx" ext) + (setq res-list (cons cls res-list))) + (save-excursion + (let* ((file (eap-find-file-with-ext cls ext)) + (buf (if file (eap-find-file-noselect file)))) + (if buf + (progn + (if msg (message "%s %s.%s" msg cls ext)) + ;;(eap-message "%s.%s" cls ext) + (set-buffer buf) + (setq res-list + (append (eap-all-included-in-cpp (append res-list avoid-list) msg) + res-list)) + (kill-buffer buf) + )) + )) + )) + res-list)) + ) + +(defun eap-all-included-in-cdl (&optional avoid-list) + "Return list of used classes or packages in current CDL file excluding ones in AVOID-LIST" + (save-excursion + (goto-char 1) + (if (not (re-search-forward "^\\([^-\n]*[ \t]\\)?uses[ \t\n]+" nil t)) + nil + (let* ((package-p (not (string-match "_" (eap-class-name)))) + (re "\\(\\w+\\)\\(\\s +from\\s +\\(\\w+\\)\\)?[ \t\n]*") + res-list end-p cls pack) + (while (and (not end-p) + (looking-at re)) + ;; get current + (setq cls (eap-match-string 1)) + (setq pack (eap-match-string 3)) + ;; look for next + (goto-char (match-end 0)) + (while (looking-at "--") + ;; skip comment + (skip-chars-forward "^\n") + (skip-chars-forward " \t\n")) + (if (not (looking-at ",")) + (setq end-p t) + (skip-chars-forward ", \t\n") + (while (looking-at "--") + (skip-chars-forward "^\n") + (skip-chars-forward " \t\n")) + ) + ;; add found to list + (if package-p + nil + (if (null pack) + (setq cls (eap-find-pack-for-class cls)) + (setq cls (concat pack "_" cls))) + ) + (and cls + (not (member cls avoid-list)) + (setq res-list (cons cls res-list))) + ) + res-list))) + ) +(defun eap-pearent () + "Find the inherited class name" + (if (eq 'cdl-mode (eap-file-mode)) + (eap-pearent-from-cdl) + (eap-pearent-from-cxx)) + ) +(defun eap-pearent-from-cxx () + (if buffer-file-name + (save-excursion + (let* ((hxx-p t) + (cls (eap-class-name)) + (file-name (or (eap-find-file-with-ext cls "hxx" t) + (setq hxx-p nil) + (eap-find-file-with-ext cls "cdl" t))) + pearent) + (if file-name + (let* ((buf (set-buffer (eap-find-file-noselect file-name)))) + (if hxx-p + (setq pearent (eap-pearent-from-hxx)) + (setq pearent (eap-pearent-from-cdl))) + (kill-buffer buf)) + ) + pearent)) + ) + ) +(defun eap-pearent-from-hxx () + (save-excursion + (let ((re (concat "class " + (eap-class-name (or buffer-file-name (buffer-name))) + "[ ]*:[ \t\n]*\\(public\\|private\\)?[ \t\n]*\\([^ \t\n]+\\)")) + ) + (goto-char 1) + (if (re-search-forward re nil t) + (eap-match-string 2)))) + ) +(defun eap-pearent-from-cdl () + (save-excursion + (goto-char 1) + (if (re-search-forward + (concat "^[^-\n]*inherits[\t\n\ ]+\\(\\w+\\)[\t\n\ ]+" + "\\(from[\t\n\ ]+\\(\\w+\\)\\)?") + (save-excursion ;; this is a boundary for a search + (re-search-forward "^[^-\n]*class[ \t\n]+" nil t) + (re-search-forward "^[^-\n]*\\(uses\\|raises\\|is\\|class\\)[ \t\n]+" nil t)) + t) + (let* ((cl (eap-match-string 1)) + (pack (eap-match-string 3))) + (if (null pack) + (eap-find-pack-for-class cl) + (concat pack "_" cl) + ))) + ) + ) +(defun eap-all-def-files (class) + "Find all CLASS definition files \(full names), searching in 'FILES'" + (save-excursion + (let* ((pack (eap-get-package-name class)) + (cls (eap-class-name class)) + (true-cls (eap-class-name-by-method-def class)) + (cls-re (concat "\\(" cls (if true-cls "\\|") true-cls "\\)")) + (re (concat "^ *\\(" cls-re "_[^.]+[.][cgl]xx\\)")) + (n 0) + def-list wb-path stop-p) + (while (and (not stop-p) + (setq wb-path (cdr (nth n csf-ref-list)))) + (setq n (1+ n)) + (let ((files-buf (eap-find-file-noselect (concat wb-path "src/" pack "/FILES"))) + def) + (set-buffer files-buf) + (setq stop-p (< 0 (buffer-size))) + (while (re-search-forward re nil t) + (if (setq def (eap-find-file-in (match-string 1))) + (add-to-list 'def-list def)) + ) + (and true-cls + (setq def (eap-find-source true-cls (not 'declaration))) + (add-to-list 'def-list def)) + (kill-buffer files-buf) + (if (setq def (eap-find-file-with-ext cls "lxx")) + (add-to-list 'def-list def)) + )) + (nreverse def-list))) + ) +(defvar eap-inherited-walked-over () + "List of files visited by 'eap-walk-over-inherited. +Files are without directory" + ) +(defun eap-walk-over-inherited (body source &optional throughAll declaration-p any-p) + "Returns first non-nil result recieved when executing BODY, if THROUGHALL +is nil. If THROUGHALL is non-nil, returns last result. +SOURCE is either file or buffer or type to start from. +ANY-P allows walk to \(not DECLARATION-P) when DECLARATION-P not found" + (save-excursion + (let* ((def-files-list (if declaration-p '(t))) + buffer result) + (setq eap-inherited-walked-over nil) + ;; find source buffer + (if (bufferp source) + (setq buffer source) + (or (stringp source) + (error "eap-walk-over-inherited: SOURCE is neither buffer nor string") ) + (let ((src (or (eap-find-source source declaration-p) + (if any-p (eap-find-source source (not declaration-p))) + ))) + (if src + (setq buffer (eap-find-file-noselect src))) + ) + ) + ;; walk trough parents + (while (and (bufferp buffer) + (set-buffer buffer) + (add-to-list 'eap-inherited-walked-over + (file-name-nondirectory buffer-file-name)) + (if (not throughAll) + (null (setq result (funcall body))) + (funcall body) + t)) + (let* (file) + (or (eq t (car def-files-list)) + (progn + ;; switch [cg]xx -> *_1.[cg]xx -> lxx + (or def-files-list + (setq def-files-list (eap-all-def-files buffer-file-name))) + (setq file (car def-files-list)) + (setq def-files-list (or (cdr def-files-list) + '(t))) + )) + ;; next inherited + (or file + (and (setq file (eap-pearent)) + (setq file (or (eap-find-source file declaration-p) + (if any-p (eap-find-source file (not declaration-p))))) + (setq def-files-list (if declaration-p '(t))) ;; try all defs again + ) + ) + (or (eq buffer source) + (kill-buffer buffer)) + (if file + (setq buffer (eap-find-file-noselect file)) + (setq buffer nil)) + ) + ) + (and (buffer-live-p buffer) + (not (eq buffer source)) + (kill-buffer buffer)) + result)) + ) + +(provide 'class-info) diff --git a/src/WOKsite/public_el/csf-c++-mode.el b/src/WOKsite/public_el/csf-c++-mode.el new file mode 100644 index 0000000..8cd69be --- /dev/null +++ b/src/WOKsite/public_el/csf-c++-mode.el @@ -0,0 +1,251 @@ +;; +;; definitions for c++-mode, loaded at first c++-mode invocation + +(load-library "c++-mode") + +;; hook to insert header in new C++ file +(defun csf-c++-mode-init () + (abbrev-mode 1) + (if (zerop (buffer-size)) ; insert in new files + (c++-file-header)) + (setq font-lock-maximum-decoration 2) + (font-lock-mode 1)) + + +;; keys +; \M-i insert #include +(define-key c++-mode-map "\M-I" " #include <>") +; \M-I add include file +(define-key c++-mode-map "\M-i" 'c++-add-include) +; \M-= insert function header +(define-key c++-mode-map "\M-=" 'c++-function-header) +; \M-h put "Handle()" around the current symbol +(define-key c++-mode-map "\M-h" 'c++-handlify) +; \M-s frame a comment block +(define-key c++-mode-map "\M-s" 'c++-frame-comments) +; \M-m insert a modified comment +(define-key c++-mode-map "\M-m" 'c++-modif) +; \M-c turn a header to an implemantation +(define-key c++-mode-map "\M-c" 'c++-header-to-code) +; \M-e insert an exception raise +(define-key c++-mode-map "\M-e" 'c++-raise) +; \M-g complete a set or get filed method +;(define-key c++-mode-map "\M-g" 'c++-getorset) +; \M-H insert C++ Header +(define-key c++-mode-map "\M-H" 'c++-file-header) + + + +(defun c++-file-header () + "insert a header at beginnig of buffer" + (interactive) + (beginning-of-buffer) + (insert "// File:\t" (buffer-name)) + (insert "\n// Created:\t" (current-time-string)) + (insert "\n// Author:\t" (user-full-name)) + (insert "\n//\t\t<" (user-login-name) "@" (system-name)">\n") + ;; different headers for .hxx files + (cond + ((string-match "\\.hxx$" (buffer-name)) + (let ( + (name + (concat (substring (buffer-name) 0 -4) "_HeaderFile") + )) + (insert "\n\n#ifndef " name) + (insert "\n#define " name) + (insert "\n\n\n\n#endif"))) + + ((string-match "\\.cxx$" (buffer-name)) + (insert "\n\n#include <" + (substring (buffer-name) 0 -4) + ".ixx>\n")) + )) + +(defun c++-function-header () + "insert a header comment for the c++ function on the current line" + (interactive) + (beginning-of-line) + (if (looking-at ".*::\\([^ (]*\\)") + (let (p (name (buffer-substring (match-beginning 1) (match-end 1)))) + (insert "//=======================================================================") + (insert "\n//function : " name) + (insert "\n//purpose : " ) (setq p (point)) + (insert "\n//=======================================================================\n\n") + (goto-char p) +))) + +(defun c++-handlify () + "insert the string handle before and two () around the symbol under the point" + (interactive) + (if (eq (point) (point-max)) () (forward-char 1)) + (forward-word -1) + (while (eq 95 (char-after (1- (point)))) (forward-word -1)) + (insert "Handle(") + (forward-word 1) + (while (eq 95 (char-after (point))) (forward-word 1)) + (insert ")")) + +(defun c++-frame-comments () + "Add a line of stars before and after a block of comments" + (interactive) + (save-excursion + ;; are we in a block of comments ? + (beginning-of-line) + (if (looking-at "[\t ]*//") + (progn + (while (and (looking-at "[\t ]*//") (not (eq (point) 1))) + (forward-line -1)) + (end-of-line) (insert "\n// ") + (c++-indent-line) + (while (not (eq (current-column) fill-column)) (insert "*")) + (forward-line 1) + (while (looking-at "[\t ]*//") + (forward-line 1)) + (if (not (eq (point) (point-max)))(backward-char 1)) + (insert "\n// ") + (c++-indent-line) + (while (not (eq (current-column) fill-column)) (insert "*")) + )))) + + +;; add a modified entry at the beginning of the file +(defun c++-modif () + "Add a modification comment line after the header of the file" + (interactive) + (save-excursion + (beginning-of-buffer) + (while (looking-at "^//") (forward-line 1)) + (insert "// Modified by " (user-login-name) ", " (current-time-string) "\n" + ))) + +;; +(defun c++-header-to-code () + "Assume that the current line is a method declaration coming from a .hxx and turn it into an implementation" + (interactive) + (beginning-of-line) + (let ((constructor (looking-at (substring (buffer-name) 0 -4))) + (pos)) + (if (not constructor) (search-forward " ")) + (insert (buffer-name)) + (delete-backward-char 4) + (insert "::") + (c++-function-header) + (forward-line 3) + (beginning-of-line) + (setq pos (point)) + (end-of-line) + (while (search-backward "Handle_" pos t) + (forward-char 6) + (delete-char 1) + (insert "(") + (forward-word 1) (while (looking-at "_") (forward-word 1)) + (insert ")")) + (end-of-line) + (delete-backward-char 1) + (c++-indent-command) + (end-of-line) + (if constructor (insert " :")) + (newline) (insert "{") (newline) (insert "}") (newline) (newline) + (forward-line)) +) + +(defun c++-raise (Exception Package) + "Insert an exception raise call." + (interactive "sException : \nsPackage (Standard) : ") + (if (equal Package "") (setq Package "Standard")) + (let (p Method) + (save-excursion + (if (beginning-of-defun) + (progn + (forward-line -1) + (beginning-of-line) + (setq Method (buffer-substring (progn + (search-forward "::") + (forward-word -1) + (forward-char -1) + (if (looking-at "_") + (forward-word -1) + (forward-char 1)) + (point)) + (progn + (search-forward "(") + (forward-char -1) + (point))))))) + (if Method + (progn + (insert "\t" Package "_" Exception "_Raise_if(,") + (setq p (point)) + (insert "\"" Method "\");") + (c++-indent-line) + (goto-char p))))) + + +(defun c++-getorset () + "Fill the current method as a set or get field method" + (interactive) + (let (linestart isget fieldname argname) + (beginning-of-line) + (setq startline (point)) + ;; test if it the line ends with const + (end-of-line) + (forward-word -1) + (setq isget (looking-at "const")) + (search-backward "::" startline t) + (forward-char 2) + (setq fieldname (buffer-substring (point) + (progn (forward-word 1) (point)))) + (if (not isget) + (progn (end-of-line) + (search-backward ")") + (forward-word -1) + (setq argname (buffer-substring + (point) + (progn (forward-word 1) (point)))))) + (forward-line 1) + (end-of-line) + (insert "\n") + (c++-indent-line) + (if isget (insert "return ")) + (insert "my" fieldname) + (if (not isget) (insert " = " argname)) + (insert ";") + )) + + + + + + +(defun c++-find-include () + "Find the cdl file of the class near point in other window." + (interactive) + (let (class package) + (save-excursion + (if (eq (point) (point-max)) () (forward-char 1)) + (forward-word -1) + (while (eq 95 (char-after (1- (point)))) (forward-word -1)) + (if (looking-at "\\(\\w+\\)_\\(\\w+\\)") + (setq + package (buffer-substring (match-beginning 1) (match-end 1)) + class (buffer-substring (match-beginning 2) (match-end 2))) + (forward-char 1) + (forward-word -1) + (setq pos (point)) + (forward-word 1) + (setq package (buffer-substring pos (point))))) + + (if class (setq class (concat package "_" class)) + (setq class package)))) + + + +(defun c++-add-include () + (interactive) + (let (class) + (save-excursion + (setq class (c++-find-include)) + (search-backward-regexp "^#include") + (next-line 1) + (insert (concat "#include <" class ".hxx>\n")) + (princ (concat "Insertion: #include <" class ".hxx> done."))))) + diff --git a/src/WOKsite/public_el/csf-cdl-mode.el b/src/WOKsite/public_el/csf-cdl-mode.el new file mode 100644 index 0000000..3360dd4 --- /dev/null +++ b/src/WOKsite/public_el/csf-cdl-mode.el @@ -0,0 +1,30 @@ +;; definitions for the CDL mode +;; called at the first CDL mode invocation + + +(defun csf-cdl-mode-init () + (setq fill-column 70) + (cdl-fill-mode 1) + (abbrev-mode 1) + (setq cdl-auto-fill-function 'csf-cdl-do-auto-fill) + (setq auto-fill-function cdl-auto-fill-function) +(font-lock-mode 1)) + + +(defun csf-cdl-do-auto-fill () + "" + (if (cdl-in-comment) + (progn + (cdl-comment-do-auto-fill) + (cdl-comment-fill nil) + (if (eolp) + (insert " "))))) + +;; We define here all the cdl keywords +(setq cdl-default-keywords + '( + "\\<\\(alias\\|any\\|as\\|class\\|deferred\\|domain\\|end\\|engine\\|enumeration\\|exception\\|executable\\|fields\\|friends\\|from\\|generic\\|immutable\\|imported\\|in\\|inherits\\|instantiates\\|interface\\|is\\|like\\|me\\|mutable\\|myclass\\|out\\|package\\|private\\|protected\\|raises\\|redefined\\|returns\\|schema\\|signature\\|static\\|uses\\|verifies\\)\\>" + ("---.*:" 0 cdl-rubrique-face t))) + +(defun cdl-in-comment ()) + diff --git a/src/WOKsite/public_el/csf-tools.el b/src/WOKsite/public_el/csf-tools.el new file mode 100644 index 0000000..1657fce --- /dev/null +++ b/src/WOKsite/public_el/csf-tools.el @@ -0,0 +1,70 @@ +;;; csf-tools.el --- auxilary tools about CSF and woksh + +;;;Author :Edward AGAPOV +;;;History :Mon Dec 10 2001 Creation + +;;; Key binding: +;; (csf-tools-key) binds +;; 'eap-what-toolkit to M-C-t + +(require 'eap-csf) + +(defun eap-what-toolkit (&optional cur-word-p file-or-cls) + "Say and copy toolkit name a current package belongs to. +Current package is either +- current-word \(if called with prefix argument) or +- package of visited file or +- package of file current in *Dired* or *Buffer List*" + (interactive "P") + (let* ((cur-file (or file-or-cls (eap-current-file t))) + (pack (if cur-word-p + (eap-get-package-name (eap-current-word)) + (if cur-file (eap-get-package-name cur-file)))) + (re (concat "^ *" pack "[ \t\n]")) + ref-list tk checked-tk-list msg) + (if (null pack) + (error "eap-what-toolkit: current package not found") + (setq msg (message "'%s' is in toolkit... " pack)) + (eap-csf-check (if (string-match "[/\\]" (or file-or-cls "")) file-or-cls)) + (setq ref-list csf-ref-list) + (while ref-list + (save-excursion + (let* ((wb-path (cdr (car ref-list))) + (udlist (eap-find-file-noselect (concat wb-path "adm/UDLIST"))) + ) + ;;(message "%s look through '%s'" msg (car (car ref-list))) + (setq ref-list (cdr ref-list)) + (while (and (set-buffer udlist) + (re-search-forward "^[ \t]*t[ \t]\\([a-z0-9]+\\)[ \t\n\C-M]" nil t)) + (setq tk (match-string 1)) + (if (member tk checked-tk-list) + (setq tk nil) + (save-excursion + (set-buffer (eap-find-file-noselect (concat wb-path "src/" tk "/PACKAGES"))) + (or (zerop (buffer-size)) + (add-to-list 'checked-tk-list tk)) + (or (re-search-forward re nil t) + (setq tk nil)) + (kill-this-buffer) + ) + (and tk + (goto-char (point-max));; stop toolkits iteration + (setq ref-list nil));; stop wb iteration + ) ;; if memeber tk checked-tk-list + ) ;; while more tks in UDLIST + (kill-buffer udlist) + ))) + ) + (if (interactive-p) + (if tk + (message "%s %s (copied)" msg tk) + (message "%s Not found" msg))) + (if tk (kill-new tk)) + tk) + ) + +(defun csf-tools-key () + (global-set-key "\M-\C-t" 'eap-what-toolkit) + ) + +(provide 'csf-tools) diff --git a/src/WOKsite/public_el/eap-pc-mode.el b/src/WOKsite/public_el/eap-pc-mode.el new file mode 100644 index 0000000..7719b51 --- /dev/null +++ b/src/WOKsite/public_el/eap-pc-mode.el @@ -0,0 +1,368 @@ +;; + +;;; Modified pc-selection-mode + +;;; New feature: a text is copied immediately when selected + + +(defvar eap-last-mark-pos nil + "is alist \(mark point)") + +(defun eap-copy-region-as-kill (beg end) + (interactive "r") + (kill-new (buffer-substring-no-properties (mark) (point)) + ;; REPLACE + (or (member (point) eap-last-mark-pos) + (member (mark) eap-last-mark-pos)) + ) + (setq eap-last-mark-pos (list (mark) (point))) + ) +(defun ensure-mark() + (if (not mark-active) + (progn (set-mark (point)) + (make-local-variable 'eap-last-mark-pos)) + )) +;; (set-mark-command nil))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;; forward and mark +;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun forward-char-mark (&optional arg) + (interactive "p") + (ensure-mark) + (forward-char arg) + (eap-copy-region-as-kill (point) (mark))) +(defun forward-word-mark (&optional arg) + (interactive "p") + (ensure-mark) + (forward-word arg) + (eap-copy-region-as-kill (point) (mark))) +(defun forward-whole-word-mark (&optional arg) + (interactive "p") + (ensure-mark) + (and (= (skip-syntax-forward "w_") 0) + (skip-syntax-forward "^w_") + (skip-syntax-forward "w_")) + (eap-copy-region-as-kill (point) (mark))) +(defun forward-paragraph-mark (&optional arg) + (interactive "p") + (ensure-mark) + (forward-paragraph arg) + (eap-copy-region-as-kill (point) (mark))) +(defun next-line-mark (&optional arg) + (interactive "p") + (ensure-mark) + (next-line arg) + (eap-copy-region-as-kill (point) (mark)) + (setq this-command 'next-line)) + +(defun end-of-line-mark (&optional arg) + (interactive "p") + (ensure-mark) + (end-of-line arg) + (eap-copy-region-as-kill (point) (mark)) + (setq this-command 'end-of-line)) + +(defun scroll-down-mark (&optional arg) + (interactive "P") + (ensure-mark) + (scroll-down arg) + (eap-copy-region-as-kill (point) (mark))) + +(defun end-of-buffer-mark (&optional arg) + (interactive "P") + (ensure-mark) + (let ((size (- (point-max) (point-min)))) + (goto-char (if arg + (- (point-max) + (if (> size 10000) + ;; Avoid overflow for large buffer sizes! + (* (prefix-numeric-value arg) + (/ size 10)) + (/ (* size (prefix-numeric-value arg)) 10))) + (point-max)))) + (if arg (forward-line 1) + (if (let ((old-point (point))) + (save-excursion + (goto-char (window-start)) + (vertical-motion (window-height)) + (< (point) old-point))) + (progn + (overlay-recenter (point)) + (recenter -3)))) + (eap-copy-region-as-kill (point) (mark))) + +;;;;;;;;; +;;;;; no mark +;;;;;;;;; + +(defun forward-char-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (forward-char arg)) + +(defun forward-word-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (forward-word arg)) +(defun forward-whole-word-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (if (not (= (skip-syntax-forward "w_") 0)) + 1 + (skip-syntax-forward "^w") + (skip-syntax-forward "w_"))) +(defun forward-paragraph-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (forward-paragraph arg)) + +(defun next-line-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (next-line arg) + (setq this-command 'next-line)) + +(defun end-of-line-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (end-of-line arg) + (setq this-command 'end-of-line)) + +(defun scroll-down-nomark (&optional arg) + (interactive "P") + (setq mark-active nil) + (scroll-down arg)) + +(defun end-of-buffer-nomark (&optional arg) + (interactive "P") + (setq mark-active nil) + (let ((size (- (point-max) (point-min)))) + (goto-char (if arg + (- (point-max) + (if (> size 10000) + ;; Avoid overflow for large buffer sizes! + (* (prefix-numeric-value arg) + (/ size 10)) + (/ (* size (prefix-numeric-value arg)) 10))) + (point-max)))) + (if arg (forward-line 1) + (if (let ((old-point (point))) + (save-excursion + (goto-char (window-start)) + (vertical-motion (window-height)) + (< (point) old-point))) + (progn + (overlay-recenter (point)) + (recenter -3))))) + + +;;;;;;;;;;;;;;;;;;;; +;;;;;; backwards and mark +;;;;;;;;;;;;;;;;;;;; + +(defun backward-char-mark (&optional arg) + (interactive "p") + (ensure-mark) + (backward-char arg) + (eap-copy-region-as-kill (point) (mark))) + +(defun backward-word-mark (&optional arg) + (interactive "p") + (ensure-mark) + (backward-word arg) + (eap-copy-region-as-kill (point) (mark))) +(defun backward-whole-word-mark (&optional arg) + (interactive "p") + (ensure-mark) + (and (= (skip-syntax-backward "w_") 0) + (skip-syntax-backward "^w_") + (skip-syntax-backward "w_")) + (eap-copy-region-as-kill (point) (mark))) + +(defun backward-paragraph-mark (&optional arg) + (interactive "p") + (ensure-mark) + (backward-paragraph arg) + (eap-copy-region-as-kill (point) (mark))) + +(defun previous-line-mark (&optional arg) + (interactive "p") + (ensure-mark) + (previous-line arg) + (eap-copy-region-as-kill (point) (mark)) + (setq this-command 'previous-line)) + +(defun beginning-of-line-mark (&optional arg) + (interactive "p") + (ensure-mark) + (beginning-of-line arg) + (eap-copy-region-as-kill (point) (mark))) + + +(defun scroll-up-mark (&optional arg) + (interactive "P") + (ensure-mark) + (scroll-up arg) + (eap-copy-region-as-kill (point) (mark))) + +(defun beginning-of-buffer-mark (&optional arg) + (interactive "P") + (ensure-mark) + (let ((size (- (point-max) (point-min)))) + (goto-char (if arg + (+ (point-min) + (if (> size 10000) + ;; Avoid overflow for large buffer sizes! + (* (prefix-numeric-value arg) + (/ size 10)) + (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) + (point-min)))) + (if arg (forward-line 1)) + (eap-copy-region-as-kill (point) (mark))) + +;;;;;;;; +;;; no mark +;;;;;;;; + +(defun backward-char-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (backward-char arg)) + +(defun backward-word-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (backward-word arg)) +(defun backward-whole-word-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (if (not (= (skip-syntax-backward "w_") 0)) + 1 + (skip-syntax-backward "^w") + (skip-syntax-backward "w_"))) +(defun backward-paragraph-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (backward-paragraph arg)) + +(defun previous-line-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (previous-line arg) + (setq this-command 'previous-line)) + +(defun beginning-of-line-nomark (&optional arg) + (interactive "p") + (setq mark-active nil) + (beginning-of-line arg)) + +(defun scroll-up-nomark (&optional arg) + (interactive "P") + (setq mark-active nil) + (scroll-up arg)) + +(defun beginning-of-buffer-nomark (&optional arg) + (interactive "P") + (setq mark-active nil) + (let ((size (- (point-max) (point-min)))) + (goto-char (if arg + (+ (point-min) + (if (> size 10000) + ;; Avoid overflow for large buffer sizes! + (* (prefix-numeric-value arg) + (/ size 10)) + (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) + (point-min)))) + (if arg (forward-line 1))) + + +(defun eap-yank (arg) + (interactive "*P") + (let ((transient-mark-mode nil)) + (yank arg) + (setq this-command 'yank)) + ) + +(defun backward-delete-word (arg) + "Delete ARG words backward but doesn't not copy it." + (interactive "*p") + (delete-region (point) + (save-excursion (backward-word arg) (point))) + ) +(defun delete-word (arg) + "Delete ARG words forward but doesn't not copy it." + (interactive "*p") + (delete-region (point)(save-excursion (forward-word arg) (point))) + ) +(defun eap-pc-mode-key () + "Modified pc-select. + New feature: selected text is copied right away, like when selecting text with mouse-3" + (interactive) + + (setq transient-mark-mode t) + ;; *Non-nil means deactivate the mark when the buffer contents change. + + (setq mark-even-if-inactive t) + ;; *Non-nil means you can use the mark even when inactive. + ;; This option makes a difference in Transient Mark mode. + ;; When the option is non-nil, deactivation of the mark + ;; turns off region highlighting, but commands that use the mark + ;; behave as if the mark were still active. + + (delete-selection-mode 1) + ;; Toggle Delete Selection mode. + ;; When ON, typed text replaces the selection if the selection is active. + ;; When OFF, typed text is just inserted at point. + + (add-hook 'pre-command-hook 'delete-selection-pre-hook) + + (define-key global-map [S-right] 'forward-char-mark) + (define-key global-map [right] 'forward-char-nomark) + (define-key global-map [C-S-right] 'forward-word-mark) + (define-key global-map [C-right] 'forward-word-nomark) + (define-key global-map [M-S-right] 'forward-whole-word-mark) + (define-key global-map [M-right] 'forward-whole-word-nomark) + + (define-key global-map [S-down] 'next-line-mark) + (define-key global-map [down] 'next-line-nomark) + + (define-key global-map [S-end] 'end-of-line-mark) + (define-key global-map [end] 'end-of-line-nomark) + (global-set-key [S-C-end] 'end-of-buffer-mark) + (global-set-key [C-end] 'end-of-buffer-nomark) + + (define-key global-map [S-next] 'scroll-up-mark) + (define-key global-map [next] 'scroll-up-nomark) + + (define-key global-map [S-left] 'backward-char-mark) + (define-key global-map [left] 'backward-char-nomark) + (define-key global-map [C-S-left] 'backward-word-mark) + (define-key global-map [C-left] 'backward-word-nomark) + (define-key global-map [M-S-left] 'backward-whole-word-mark) + (define-key global-map [M-left] 'backward-whole-word-nomark) + + (define-key global-map [S-up] 'previous-line-mark) + (define-key global-map [up] 'previous-line-nomark) + + (define-key global-map [S-home] 'beginning-of-line-mark) + (define-key global-map [home] 'beginning-of-line-nomark) + (global-set-key [S-C-home] 'beginning-of-buffer-mark) + (global-set-key [C-home] 'beginning-of-buffer-nomark) + + (define-key global-map [S-prior] 'scroll-down-mark) + (define-key global-map [prior] 'scroll-down-nomark) + + (define-key global-map [S-insert] 'eap-yank) + + ;; some key remapping + + (global-set-key [delete] 'delete-char) + (global-set-key [C-delete] 'delete-word) + (global-set-key [S-delete] 'kill-word) + (global-set-key [S-backspace] 'backward-kill-word) + (global-set-key [C-backspace] 'backward-delete-word) + ) + +(provide 'eap-pc-mode) diff --git a/src/WOKsite/public_el/edl-mode.el b/src/WOKsite/public_el/edl-mode.el new file mode 100644 index 0000000..0be2cf9 --- /dev/null +++ b/src/WOKsite/public_el/edl-mode.el @@ -0,0 +1,87 @@ +;;;File :edl-mode.el +;;;Author :Mister CSF +;;;Purpose : +;;;History :Wed Sep 6 13:58:12 1995 Mister CSF Creation + + +(defun edl-new-file-header () + "Insert a header in each empty .edl buffer " + (interactive) + (insert "-- File: " (buffer-name)) + (insert "\n-- Created: " (format-time-string "%d.%m.%y %H:%M:%S")) + (insert "\n-- Author: " (concat (user-login-name) "@" (system-name))) + (insert "\n-- Copyright: Open CASCADE " (format-time-string "%Y") "\n\n") + (let ( + (name + (concat "%" (substring (buffer-name) 0 -4) "_EDL") + )) + (insert "@ifnotdefined ( " name ") then\n" ) + (insert "@set " name " = \"\";\n\n")) + (insert "--- Insert your stuff Here\n\n\n") + (insert "@endif;\n") + ) + + +;; face carac for functions +;;(make-face 'edltmp-function-face) +;;(set-face-foreground 'edltmp-function-face "darkred") +;;(defvar edl-function-face 'edltmp-function-face) +(defvar edl-function-face 'font-lock-keyword-face) +;; face carac for variable +;;(make-face 'edltmp-variable-face) +;;(set-face-foreground 'edltmp-variable-face "darkgreen") +;;(defvar edl-variable-face 'edltmp-variable-face) +(defvar edl-variable-face 'font-lock-variable-name-face) +;; face carac for comment +;;(make-face 'edltmp-comment-face) +;;(set-face-foreground 'edltmp-comment-face "grey") +;;(defvar edl-comment-face 'edltmp-comment-face) +(defvar edl-comment-face 'font-lock-comment-face) +;; face carac for template clause +;;(make-face 'edltmp-template-face) +;;(set-face-foreground 'edltmp-template-face "darkblue") +;;(defvar edl-template-face 'edltmp-template-face) +(defvar edl-template-face 'font-lock-keyword-face) +;; face carac for template name +;;(make-face 'edltmp-templatename-face) +;;(set-face-foreground 'edltmp-templatename-face "red") +;;(defvar edl-templatename-face 'edltmp-templatename-face) +(defvar edl-templatename-face 'font-lock-function-name-face) +;; face carac for string clause +;;(defvar edl-string-face 'underlined) +(defvar edl-string-face 'font-lock-string-face) +;; + +(setq edl-default-keywords + '( +;; les commandes @ puis le mot-cle + ("\\@\\(openlib\\|closelib\\|call\\|apply\\|set\\|string\\|ifdefined\\|ifnotdefined\\|if\\|endif\\|cout\\|write\\|file\\|close\\|while\\|endw\\|uses\\)" . edl-function-face) +;; les commentaires -- fin de ligne + ("--.*$" . edl-comment-face ) +;; inside template juste le $ ou @template +("\\(\\$\\|\\@template\\|\\@end;\\).*$" 1 edl-template-face ) +;; le nom du template +("\\@template[^a-z|^A-Z|^0-9^_^-]+\\([a-z|A-Z|0-9|_-]*\\)[^a-z|^A-Z|^0-9|^_^-].*$" 1 edl-templatename-face ) + ("\\(\\%[a-z|A-Z|0-9_-]*\\)[^a-z|^A-Z|^0-9^_]" 1 edl-variable-face) +;; les variables % un nom puis caractere exotique .. a verifier +;; les string + +) + ) + +(defun edl-mode () +"This is a mode intended to support EDL documentation writing + +\\{edl-mode-map} +" + (interactive) + (setq major-mode 'edl-mode) + (setq mode-name "EDL") + (setq auto-fill-hook nil) + (setq require-final-newline t) + (if (zerop (buffer-size)) (edl-new-file-header)) + (make-local-variable 'font-lock-mode-hook) + (setq font-lock-mode-hook + '(lambda () (setq font-lock-keywords edl-default-keywords))) + (run-hooks 'edl-mode-hook)) + diff --git a/src/WOKsite/public_el/faces.el b/src/WOKsite/public_el/faces.el new file mode 100644 index 0000000..8545365 --- /dev/null +++ b/src/WOKsite/public_el/faces.el @@ -0,0 +1,103 @@ +;;;File :faces.el +;;;Author :Alexander GRIGORIEV +;;;Purpose : +;;;History :Tue Apr 11 19:01:47 2000 creation + +(defun hilit-compiler-message-init() + (message "Welcome to WOK compilation font-lock-mode") + (make-local-variable 'font-lock-mode-hook) + ;; + ;; information face + ;; + (make-face 'i-face) + (set-face-foreground 'i-face "DarkGreen") + (defvar information-face 'i-face) + ;; + ;; compilating face + ;; + (make-face 'c-face) + (set-face-foreground 'c-face "DarkSlateBlue") + (defvar compilating-face 'c-face) + ;; + ;; warning face + ;; + (make-face 'w-face) + (set-face-foreground 'w-face "brown") + (defvar warning-face 'w-face) + ;; + ;; error face + ;; + (make-face 'e-face) + (set-face-foreground 'e-face "red") + (defvar error-face 'e-face) + ;; + ;; keywords face + ;; + (make-face 'k-face) + (set-face-foreground 'k-face "blue") + (defvar wok-keywords-face 'k-face) + ;; + ;; command prompt face + ;; + (make-face 'p-face) + (set-face-foreground 'p-face "DarkBlue") + (defvar cmdprompt-face 'p-face) + + (make-variable-buffer-local 'compiler-messages) + + (defvar compiler-messages nil "*Default list of messages for font-lock") + + (setq compiler-messages + '( + ("^:.+:.*\\[[0-9]+\\]>" . cmdprompt-face) + ("[a-z]+_[a-z]+\\[[0-9]+\\].*:.*>" . cmdprompt-face) + ;; information lines use information face +;; ("^\\(.+: [I|i]nformation : .*$\\)" . information-face) +;; ("^\\(Information: .*$\\)" . information-face) + ("^\\(Info[ ]*: .*$\\)" . information-face) + ("^make\\(:\\|\\[[0-9]+\\]:\\).*$" . information-face) + ;; + ;; warning lines use warning face + ;; for cdl tools + ;; + ("^\\(.+: Warning : .*$\\)" . warning-face) + ("^\\(Warning: .*$\\)" . warning-face) + ("^[ \t]*is newer than .*:.*$" . warning-face) + ;; + ;; for compilation + ;; + ("^------->.*$" . compilating-face) + ;; for usual compilers + ("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+: [w|W]arning:.*$" . warning-face) + ("^.*line [0-9].*: [w|W]arning:.*$" . warning-face) + ("^.+\\(: [w|W]arning:.*$\\)" . warning-face) + ;; error lines use error face + ;; for cdl tools + ("^\\(.+: [e|E]rror[ \t]*: .*$\\)" . error-face) + ("^\\(Error : .*$\\)" . error-face) + ("^\\(Warning : .*$\\)" . warning-face) + ("^\\(Info : .*$\\)" . information-face) + ;; for usual compilers + ("^[-_.\"A-Za-z0-9/]+\\(:\\|, line \\)[0-9]+: [e|E]rror:.*$" . error-face) + ("^.+\\(:\\|, line \\)[0-9]+: [e|E]rror:.*$" . error-face) + ("^.+\\(: [e|E]rror:.*$\\)" . error-face) + ("^\\*\\*\\* Error code.*$" . error-face) + ("\"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[:., (-].*$" . error-face) + ;; for linker + + ;; essai juste pour le plaisir les commandes wok + ("\\(^\\|[ \t]+\\)\\([fWswu]create\\|[fsWup]info\\|w_info\\|wdrv\\|wsrc\\|winc\\|wlib\\|umake\\|wokcd\\|wokparam\\|wokprofile\\|wokinfo\\|wokclose\\|wokenv\\|woklocate\\|Wdeclare\\|info-config\\|[fs]-config\\|p-get\\|p-put\\|pinstall\\|wprepare\\|wprepare\\|wintegre\\|wstore\\|wnews\\|wpack\\)\\>" . wok-keywords-face) + ("\\(^\\|[ \t]+\\)\\(\\(cr\\|rm\\)\\(unit\\|wb\\)\\|wcd\\|\\(w\\|ws\\)ls\\|dsrc\\|father\\|make\\([ \t][^ \t]+\\)?\\)\\>" . wok-keywords-face) + ;; pour les meta + ("\\(^\\|[ \t]+\\)\\(winfo\\)\\>" . error-face) + ;; + + ) + ) + + + +(setq font-lock-mode-hook + '(lambda () (setq font-lock-keywords compiler-messages))) +(font-lock-mode 1) +) diff --git a/src/WOKsite/public_el/inheritance.el b/src/WOKsite/public_el/inheritance.el new file mode 100644 index 0000000..8c83cc8 --- /dev/null +++ b/src/WOKsite/public_el/inheritance.el @@ -0,0 +1,328 @@ +;;; inheritance.el --- show inheritance of classes contained in CSF as a tree + +;;;Author : Edward AGAPOV +;;;History : Mon Dec 21 1998 Creation + +;;; Comment + +;;; Mode entry: inh-show-inheritance + +;;; Key binding: +;; (inheritance-key) binds +;; 'inh-show-inheritance to M-f7 +;; 'inh-show-buffer to C-a C-i + +(require 'type-search) +(require 'tree) + +(defconst inh-buffer-name "*inheritance*" + ) +(defvar inh-info-buffer-list nil + "List of buffers containing inheritance info. +Each member corresponds to csf-ref-list member and looks like +\(buffer . wb-path)" + ) +(defvar inh-info-path nil + "Path to inheritance info files" + ) +(defun inh-show-inheritance (of-current) + "Show tree of class inheritance. +Of current buffer class \(with prefix argument) or class at point. +See mode description for keybindings on tree management. +Type \\[inh-show-buffer] to find '*inheritance*' buffer quickly. + +Be patient calling this command for the first time for a current workbench, +building info files for all reference workbenches can take a few minutes: +for ex. 15 min on SUN Ultra 10 \(300MHz 256Mb)" + (interactive "P") + (message "inh-show-inheritance: look for current class") + (let* ((start (eap-get-back-file)) + (type (if of-current + (eap-class-name) + (eap-current-type))) + ) + (if (null type) + (error "inh-show-inheritance: no type found") + (setq inh-info-path (eap-check-tmp-path)) + (inh-buf-list-check) + (if (null (or (inh-has-descendants type) + (inh-get-ansestor type) + )) + (message "'%s' has neither ansestor nor descendants" type) + (and (not (string-match "#$" type)) + (eap-find-file-with-ext type "gxx" 'any) + (setq type (concat type "#"))) + (tree-build-tree type (inh-mode)) + (eap-save-back-file start) + ))) + ) +(defun inh-mode () + "Show inheritance of classes contained in CSF as a tree +Generic classes have '#' mark, their instantiations are shown like inheritance. +'+' before or after class means that this class has not shown ansestor or +descendants respectively. +'-' before or after class means that ansestor or all descendants respectively +of this class are shown. +Absence of '-' or '+' before or after class means that this class has not +ansestor or descendants respectively. + +Keybindings: + +\\{tree-mode-map}" + (let ((buf (get-buffer-create inh-buffer-name))) + (set-buffer buf) + (if (eq major-mode 'inh-mode) + nil + (setq tree-get-ansestor 'inh-get-ansestor + tree-has-descendants 'inh-has-descendants + tree-get-descendants-list 'inh-get-descendants-list + tree-level-width 4) + (setq major-mode 'inh-mode + mode-name "Inheritance") + ) + buf) + ) +(defun inh-get-ansestor (cls) + (let ((buf-list inh-info-buffer-list) + ans) + (save-excursion + (while (and (null ans) buf-list) + (set-buffer (car (car buf-list))) + (if (inh-find-class cls nil) + (setq ans (inh-cur-ansestor)) + (setq buf-list (cdr buf-list))) + )) + ans) + ) +(defun inh-has-descendants (cls) + (let ((buf-list inh-info-buffer-list) + has-p) + (save-excursion + (while (and (not has-p) buf-list) + (set-buffer (car (car buf-list))) + (setq has-p (inh-find-class cls 'inherited)) + (setq buf-list (cdr buf-list))) + has-p)) + ) +(defun inh-get-descendants-list (cls) + (let ((buf-list inh-info-buffer-list) + des-list) + ;;(message "Find descendants of '%s'... " cls) + (save-excursion + (while buf-list + (set-buffer (car (car buf-list))) + (if (inh-find-class cls 'inherited) + (setq des-list (append des-list + (inh-cur-des-list des-list))) + ) + (setq buf-list (cdr buf-list)) + )) + ;;(message nil) + des-list) + ) +(defvar inh-gen-des-list nil + "List of classes whose ansestor is generic descendant of non-generic class. +Such classes are found twice, this list allow treating them only once" + ) +(defun inh-buf-list-check () + (if (and (member (eap-wb-path) (mapcar 'cdr inh-info-buffer-list)) + (get-buffer inh-buffer-name)) + 'ok + ;; kill existing info buffers + (mapcar 'kill-buffer (mapcar 'car inh-info-buffer-list)) + (setq inh-info-buffer-list nil) + ;; make info buffer list + (let* ((ref-list csf-ref-list) + wb-name-path name) + (while ref-list + (setq wb-name-path (car ref-list) + ref-list (cdr ref-list) + name (car wb-name-path)) + (or (inh-find-info-file name (cdr wb-name-path)) + (if (inh-build-info-file name) + (inh-find-info-file name (cdr wb-name-path)))) + (setq inh-gen-des-list nil) + ) + )) + ) +(defun inh-find-info-file (wb-name wb-path) + (let ((file (inh-info-file-name wb-name)) buf) + (and (file-exists-p file) + (if (or (eap-file-newer-p (concat wb-path "inc") file) + (eap-file-newer-p (concat wb-path "drv") file)) + (not (y-or-n-p (format "Update inheritance info file of '%s' " wb-name))) + t) + (set-buffer (setq buf (eap-find-file-noselect file))) + (rename-buffer (concat " " (buffer-name)));; hide buffer + (setq inh-info-buffer-list (cons (cons buf wb-path) inh-info-buffer-list)) + )) + ) +(defun inh-info-file-name (wb-name) + (concat inh-info-path wb-name "_inheritance_info") + ) +(defun inh-build-info-file (wb-name) + (let* ((inc-dir (eap-wb-path "inc" wb-name)) + (headers (eap-directory-files inc-dir nil "hxx$" 'no-sort "Get headers from")) + (msg (format "Build 'inheritance_info' file for '%s':" wb-name)) + (cur-nb 1) max-nb + (generic-p t) ;; just for debugging + info-buf buf packages) + (set-buffer (setq info-buf (eap-find-file-noselect + (inh-info-file-name wb-name)))) + (erase-buffer) + (if generic-p + ;; get all cdl packages + (progn + (setq buf (eap-find-file-noselect + (concat (eap-wb-path "adm" wb-name) "UDLIST"))) + (set-buffer buf) + (while (re-search-forward "p[ \t]+\\([^ \t\n]+\\)" nil t) + (setq packages (cons (match-string 1) packages))) + (kill-buffer buf) + )) + (setq max-nb (+ (length packages) (length headers))) + ;; fill inheritance file + ;; 1. generics + (let ((drv-dir (eap-wb-path "drv" wb-name)) + pack-dir files) + (while packages + (setq pack-dir (concat drv-dir (car packages) "/")) + (setq packages (cdr packages)) + (setq cur-nb (1+ cur-nb)) + (and (file-exists-p pack-dir) + (setq files (directory-files pack-dir nil "_0[.]cxx$" 'no-sort)) + (while files + (setq buf (eap-find-file-noselect (concat pack-dir (car files)))) + (inh-fill-info-buf info-buf buf (car files) cur-nb max-nb msg 'generic) + (setq files (cdr files)) + (kill-buffer buf) + ))) + ) + ;; 2. real inheritance + (while headers + (setq buf (eap-find-file-noselect (concat inc-dir (car headers)))) + (inh-fill-info-buf info-buf buf (car headers) cur-nb max-nb msg) + (setq headers (cdr headers)) + (setq cur-nb (1+ cur-nb)) + (kill-buffer buf) + ) + (message "%s ... Done" msg) + ;; sort info + (set-buffer info-buf) + (sort-lines nil 1 (point-max)) + ;; save & kill + (or (buffer-modified-p) + (set-buffer-modified-p t)) + (let (err) + (condition-case err + (progn + (save-buffer 0) + (set-file-modes buffer-file-name 511) + ) + (error (message "inh-build-info-file: %s" err) (sit-for 1)) + )) + (kill-this-buffer) + ) + ) +(defun inh-fill-info-buf (info-buf buf file-name cur-nb max-nb msg &optional generic-p) + (set-buffer buf) + ;; get inherited + (let* ((inherited (if (not generic-p) + (eap-pearent-from-hxx) + (goto-char (point-max)) + (if (re-search-backward "^#include <\\([^.]+\\)[.]gxx>" nil t) + (match-string 1)))) + (cls (if inherited (eap-class-name file-name))) + ) + (eap-progress-indicator cur-nb max-nb msg) + ;; insert in info buffer + (if (or (null inherited) + (and (not generic-p) + (member cls inh-gen-des-list))) + nil + (set-buffer info-buf) + ;; check if cls already has generic ansestor + (and (not generic-p) + (inh-find-class cls (not 'ancestor)) + (let ((gen-ans (inh-cur-ansestor))) + ;; check that not same inheritance is found twice + (and (inh-generic-found) + (not (string= gen-ans (concat inherited "#"))) + (setq cls gen-ans + inh-gen-des-list (append (inh-cur-des-list) inh-gen-des-list))) + )) + (if (not (inh-find-class inherited 'inherited)) + ;; insert new + (progn (beginning-of-line) + (inh-insert inherited generic-p " ( " cls " )\n")) + ;; add to existing descendant list + (inh-goto-cur-des) + (inh-insert cls nil " ") + )) + )) +(defun inh-find-class (class inherited-p) + (let ((re (concat (if inherited-p "^" " ") class "[ #]")) + (search-funs '(re-search-backward . re-search-forward))) + (if (and inherited-p + (> (buffer-size) 10000)) + ;; choose direction to search, inherited are sorted + (let ((cur-inh (progn (beginning-of-line) (current-word)))) + (if (string< cur-inh class) + (setq search-funs '(re-search-forward . re-search-backward))) + (if (bobp) + (end-of-line) + (forward-char -1)) + ) + ) + (or (funcall (car search-funs) re nil t) + (funcall (cdr search-funs) re nil t) + )) + ) +(defun inh-cur-ansestor (&optional kill-p) + (beginning-of-line) + (if (looking-at "[^ ]+") + (prog1 (match-string 0) + (if kill-p (delete-region (match-beginning 0) (match-end 0))) + )) + ) +(defun inh-generic-found () + (let ((found (match-string 0))) + (= ?# (aref found (1- (length found))))) + ) +(defun inh-goto-cur-des () + (beginning-of-line) + (re-search-forward "( " nil t) + ) +(defun inh-cur-des-list (&optional avoid-list) + (let (des-list des) + (inh-goto-cur-des) + (while (looking-at "[^ )]+") + (or (member (setq des (match-string 0)) avoid-list) + (setq des-list (cons des des-list))) + (goto-char (match-end 0)) + (skip-chars-forward " ") + ) + des-list) + ) +(defun inh-insert (cls generic-p &rest args-to-insert) + (insert cls (if generic-p "#" "")) + (if args-to-insert (apply 'insert args-to-insert)) + ) + + +(defun inh-show-buffer () + (interactive) + (let* ((buf (get-buffer inh-buffer-name))) + (if buf (pop-to-buffer buf) + (message "Buffer %s doesn't exist" inh-buffer-name)))) + +(defun inheritance-key () + (define-key (eap-buf-mgt-map) "\C-i" 'inh-show-buffer) + (global-set-key [M-f7] 'inh-show-inheritance) + ) + +(mapcar 'kill-buffer (mapcar 'car inh-info-buffer-list)) +(setq inh-info-buffer-list nil) +;; (dired inh-info-path) + +(provide 'inheritance) diff --git a/src/WOKsite/public_el/method-search.el b/src/WOKsite/public_el/method-search.el new file mode 100644 index 0000000..2392f80 --- /dev/null +++ b/src/WOKsite/public_el/method-search.el @@ -0,0 +1,506 @@ +;;; method-search.el --- search for method declaration, definition, call etc. + +;;;Author : Edward AGAPOV +;;; History :Mon Mar 13 2000 Creation + +;;; Commentary: + +;; Interactive entries (with default keybindings) +;; eap-next-method C-. +;; eap-next-method-backward C-, + +;; Default keybinding is done by 'method-search-key function + +(eval-and-compile ;; a macro needed + (require 'shared) + ) + +(defun eap-next-method (only-say-name &optional backward) + "Moves cursor to the first line of the nearest method. +With prefix argument, just inform you about current method name and +copy it" + (interactive "P") + (let* ((msg (message "Look for %s method..." + (if backward (if only-say-name "current" "previous") "next"))) + (eap-method-search-boundaries nil) + (meth-ends (save-excursion + (if backward (beginning-of-line) (end-of-line)) + (eap-method-fullstring backward 'endPos 'save))) + (name (if only-say-name (eap-method-name (car meth-ends)))) + (ends (cdr meth-ends))) + (if (null ends) + (message "%s Not found" msg) + (if only-say-name + (progn + (message "%s '%s'" msg name) + (kill-new name)) + (push-mark nil nil t) + (setq mark-active nil) + (eap-set-pos-at-line (car ends) 2) + (goto-char (if backward (car ends) (cdr ends)))))) + ) +(defun eap-next-method-backward (only-say-name) + "The same as eap-next-method but backward" + (interactive "P") + (eap-next-method only-say-name 'back) + ) + +(defvar method-search-regexp-or-function + (list + (cons 'cdl-mode "^\\s *\\(\\w+\\s *\\(([^)]+)\\|returns\\)[^;]*;\\|class +[a-z0-9]+;\\|Create *;\\)") + (cons 'ccl-mode "\\(^\\s *( *def[a-z]+\\(-constant\\)?\\s +[-_a-zA-Z0-9]+[^\n]*\\)$") + (cons 'tcl-mode "^\\s *\\(proc\\s +[^\n]+\\)") + (cons 'c++-mode 'eap-cpp-method-fullstring) + (cons 'c-mode 'eap-c-method-fullstring) + (cons 'emacs-lisp-mode "\\(^\\s *( *def[a-z]+\\s +[-_a-zA-Z0-9]+[^\n]+\\)$") + ) + "*Alist mapping major-mode to . +Is used in 'eap-method-fullstring \(which see). + is used to find 'method-fullstring that is 1-st match-string. + must look like FUNCTION (&optional BACKWARD ENDPOS) +and return result of the same format as 'eap-method-fullstring." + ) +(defvar method-search-simpli-list + (list + (cons 'cdl-mode '(("[ \t]*--[^\n]*\\(\n\\|$\\)"))) + (cons 'ccl-mode '(("[ \t]*;[^\n]*\\(\n\\|$\\)"))) + (cons 'emacs-lisp-mode '(("[ \t]*;[^\n]*\\(\n\\|$\\)"))) + (cons 'tcl-mode '(("[ \t]*#[^\n]*\\(\n\\|$\\)"))) + ) + "*Alist mapping major-mode to . +Is used in 'eap-method-fullstring \(which see) as the second +argument of 'eap-simplify-string applied to string matching +corresponding to major-mode in 'method-search-regexp-or-function." + ) + +(defvar eap-method-search-boundaries nil + "Cons (UPPER-BOUNDARY . LOWER-BOUNDARY) to restrict region for the search") + +(defun eap-method-fullstring (&optional backward-p endPos save mode) + "Search for the next method head. +BACKWARD-P indicates direction. +Return: if ENDPOS not nil, ( . ) +otherwise just or nil if nothing found. +To get from the result use (nth 1 result) +and - (nthcdr 2 result). +SAVE means resore cursor position after the seach. +Use MODE to indicate major-mode if it is known for sure. If MODE is nil +or omitted it is deduced from file name or current major-mode is used." + (let* ((mode (or mode (eap-file-mode) major-mode)) + (oldPos (point)) + (bnd (funcall (if backward-p 'car 'cdr) eap-method-search-boundaries)) + (regexp-or-fun (or (cdr (assoc mode method-search-regexp-or-function)) + ;; default e-lisp + "\\(^\\s *( *def[a-z]+\\s +[-_a-zA-Z0-9]+[^\n]+\\)$")) + (case-fold-search t) + methodString pos m_p) + (if (stringp regexp-or-fun) + (and (if backward-p + (search-backward-regexp regexp-or-fun bnd t) + (search-forward-regexp regexp-or-fun bnd t)) + (setq pos (cons (match-beginning 1) (match-end 1)) + methodString (match-string 1)) + ;; special case for cdl mode +;;; (if (string-match "[\n\t ]+inherits[\t\n ]+*" methodString) +;;; (progn +;;; (goto-char (car pos)) (skip-chars-forward "^\n") +;;; (setq m_p (eap-method-fullstring backward-p endPos nil mode))) + (setq methodString + (eap-simplify-string methodString + (cdr (assoc mode method-search-simpli-list)))) + (setq m_p (if endPos (cons methodString pos) methodString)) + );;;) + (condition-case nil + (and (symbolp regexp-or-fun) + (fboundp regexp-or-fun) + (setq m_p (funcall regexp-or-fun backward-p endPos)) + ) + (error nil) + ) + ) + (if (or save (null m_p)) (goto-char oldPos)) + m_p) + ) +(defun eap-c-method-fullstring (&optional backward endPos) + (let* ((regexp "\\<\\(\\(static\\|Standard_EXPORT\\) +\\)?[_a-z0-9]+[&* \t\n]+[_a-z0-9]+\\s *([^)]*)") + (searchFun (if backward 're-search-backward 're-search-forward)) + (bndry (if backward + (or (car eap-method-search-boundaries) (point-min)) + (or (cdr eap-method-search-boundaries) (point-max)))) + str ends) + (if (null (funcall searchFun regexp bndry t)) + nil + (setq str (match-string 0) + ends (cons (match-beginning 0) (match-end 0))) + (goto-char (cdr ends)) + (if (or (not (looking-at "[\t\n ]*\\({\\|\\w\\)")) + (string-match "\\<\\(if\\|else\\|for\\)\\>" str) + (eap-in-comment) + ) + (progn (if backward (goto-char (car ends))) + (eap-c-method-fullstring backward endPos)) + ;;(setq str (eap-simplify-string str '(("\t" " ")("\n" " ")(" " " ")))) + (if endPos + (cons str ends) + str)))) + ) + +(defun eap-cpp-method-fullstring (&optional backward ends) + (if (string-match "[.]h[xp]*$" buffer-file-name) + (eap-hxx-method-fullstring backward ends) + (eap-cxx-method-fullstring backward ends) + ) + ) + +(defun eap-cxx-method-fullstring (&optional backward ends) + + (let* ((case-fold-search t) ;; ignore case + (retValue "[ \t\n]\\(static[ \t\n]+\\)?\\(const[ \t\n]+\\)?\\(Handle[( \n\t]+\\)?[_:a-z0-9]+[ )&*\n\t]+") + (meth-name "[_a-z0-9]+[ \t\n]*\\(::[ \t\n]*[_a-z0-9]+[ \t\n]*\\)?") + (constructor-name "\\([_a-z0-9]+\\)[ \t\n]*::[ \t\n]*\\2[ \t\n]*") + (arg "([ \t\n]*\\()\\|\\(const[ \t\n]+\\)?\\(Handle[( \n\t]+\\)?[_:a-z0-9]+[ )&/*\n\t]*[,)_a-z0-9]+\\)") + (regexp (format "\\(%s\\|%s%s\\)%s" constructor-name retValue meth-name arg)) + ;;;(regexp (concat "[_a-z0-9]+[ )&*\n\t]+")) + (bound (funcall (if backward 'car 'cdr) eap-method-search-boundaries)) + (re-sch-fun '(lambda () + (if bound + (if backward + (if (> (point) bound) (re-search-backward regexp bound t)) + (if (< (point) bound) (re-search-forward regexp bound t))) + (if backward + (re-search-backward regexp nil t) + (re-search-forward regexp nil t))))) + (re-search-method-fun '(lambda() + ;;(goto-char end);;(if backward beg end) + (goto-char (if backward beg end)) + (eap-cxx-method-fullstring backward ends))) + (quit-comment-fun '(lambda (comm-ends) + (goto-char + (funcall (if backward 'car 'cdr) comm-ends)))) + end beg meth-beg string + has-bad-symbols has-comm-inside has-preproc-inside + ) + (while (and (null beg) + (funcall re-sch-fun)) + (setq beg (match-beginning 1)) + (setq end (match-end 1)) + (goto-char beg) + (skip-syntax-forward "^w") + (and (or (re-search-forward + "\\<\\(if\\|else\\|return\\|new\\|switch\\|throw\\|raise\\)\\>" end t) + ;; definition or declaration ? + (save-excursion + (setq has-comm-inside + (or (eap-no-comment nil (skip-chars-forward "^{;")) + (< end (cdr eap-next-comment-ends)))) + (setq meth-beg (point)) + (not (looking-at "{"))) + ;; beg is in comment ? + (if (if has-comm-inside + (if (< (point) (car eap-next-comment-ends)) + (eap-quit-comment backward) + (funcall quit-comment-fun eap-next-comment-ends)) + (if (< (point) (cdr eap-next-comment-ends)) + (funcall quit-comment-fun eap-next-comment-ends))) + (setq end (1- (point)) ;; to see space before word + beg end)) + ) + (goto-char (if backward beg end)) + (setq beg nil) + ) + (and beg backward ;; if 'const Handle(...)' is a first arg and we skip it -> + ;; we miss a method + (re-search-forward "const[ \t]+Handle" end t) + (not (setq beg nil)) + (skip-chars-backward "^{}#;") + (if (< (point) (cdr eap-next-comment-ends)) + (goto-char (cdr eap-next-comment-ends)) t) + (save-excursion (re-search-forward regexp end t)) + (/= end (match-end 1)) ;; not the same 'const Handle(...)' + (setq beg (match-beginning 1) + end (match-end 1)) + bound ;; overgo boundary? + (< beg bound) + (setq beg nil) + ) + ) + (if (null beg) + nil + (goto-char beg) + (skip-syntax-forward "^w") + (setq beg (point)) + ;; first args parenthesis + (goto-char end) + (skip-chars-forward "^(") + ;; look for not allowed symbols that are not in comments + (while (and (not has-bad-symbols) + ;;(< (point) end) + (re-search-forward "[^][ \t\n,:*&/()_=a-z0-9]" meth-beg t)) + (if (= ?# (char-after (1- (point)))) ;; preprocessor instruction + (setq has-preproc-inside + (goto-char (min meth-beg (search-forward "\n")))) + (setq has-bad-symbols (if has-comm-inside (not (eap-quit-comment)) t))) + ) + (if has-bad-symbols + (funcall re-search-method-fun) + ;; check symbols after closing parenthesis + (goto-char end) + (skip-chars-forward "^(") + (setq end (if (not has-comm-inside) + (eap-matching-paren) + (save-excursion + (goto-char meth-beg) + (eap-no-comment 'back (skip-chars-backward "^)")) + (point)))) + (goto-char end) + ;; skip preprocessor instruction + ;;(if has-preproc-inside + (while (re-search-forward "^[^/\n]*#[^\n]+" meth-beg t )) + ;;) + ;; skip comments + (if has-comm-inside + (while (re-search-forward "[ \t\n]*\\(const[ \t\n]*\\)?/[/*]" meth-beg t) + (eap-quit-comment))) + ;; check + (if (not (looking-at "[\t\n ]*\\(const\\|throw\\)?[\t\n ]*\\([{(]\\|:[ \t\n]*[a-z0-9]\\)")) + (funcall re-search-method-fun) + ;; end = closing parenthesis + (goto-char (if backward beg end)) ; prepare for next search + (setq string (eap-simplify-string (buffer-substring-no-properties beg end) + '(("//[^\n]+") + ;;("inline[ \t]*") + ))) + (if ends + (cons string (cons beg end)) + string)))) + ) + ) + +(defun eap-hxx-method-fullstring (&optional backward ends) + (let* ((re-search-fun '(lambda() + (goto-char (if backward beg end)) + (eap-hxx-method-fullstring backward ends) + )) + (case-fold-search t) + bad-beg beg end meth-str) + ;; look for method + (if (not (funcall (if backward 're-search-backward 're-search-forward) + "\\<\\([_a-z0-9]+\\)\\s *(" nil t)) + nil + (setq beg (match-beginning 1) + end (match-end 0)) + (setq meth-str (match-string 1)) + (backward-char 1) ;; case of 1-st arg commented + (if (or (eap-in-comment) + (string-match "^\\(Handle\\|raises\\|throw\\)$" meth-str)) + (eap-hxx-method-fullstring backward ends) + ;; look for method beginning + (if (string= (eap-class-name) meth-str) ;; constructor + (setq bad-beg (1+ beg)) + (goto-char beg) + (skip-syntax-backward " ") + (setq bad-beg (point)) + (or (= 0 (skip-chars-backward ":")) ;; scope in inline implementation + (progn (skip-syntax-backward " ") + (setq bad-beg (point)))) + (skip-chars-backward "_&*()a-zA-Z0-9") ;; skip ret value + (setq beg (point)) + (while (and (skip-syntax-backward " ") + (skip-chars-backward "_a-zA-Z") ;; skip Standard_EXPORT or ... + (looking-at "\\(Standard_EXPORT\\|virtual\\|static\\|inline\\)\\>") + (not (eap-in-comment))) + (setq beg (point)) + )) + (if (or (= beg bad-beg) + (string-match "\\<\\(return\\|new\\)\\>" (buffer-substring bad-beg beg))) + (funcall re-search-fun) + ;; look for method end + (goto-char (1- end)) + (if (not (and (setq end (eap-matching-paren)) + (goto-char end) + (if (looking-at "\\s */[*/]") + (eap-quit-comment (not 'back) 'skip-space) + 'ok) + (looking-at + "\\s *\\(\\(raises\\|throw\\)\\>\\|\\(const\\s *\\)?[=0 \t\n]*[{;]\\)"))) + (funcall re-search-fun) + (setq meth-str + (eap-simplify-string (buffer-substring beg end) + '(("//[^\n]+") + ("/[^/]+/") + ("Standard_EXPORT\\s *") + ("\\(inline\\)\\s *") + ))) + (goto-char (if backward beg end)) + (if ends + (cons meth-str (cons beg end)) + meth-str) + ))) + )) + ) + +(defun eap-parse-method-call-string (method-str) + (if (not (string-match + "\\([_a-zA-Z0-9]+\\)\\(\\s *\\([.:=>-]+\\)?\\s *\\([_a-zA-Z0-9]+\\)\\)?" + method-str)) + (not (message "WRONG METHOD STRING")) + (let* ((object (match-string 1 method-str)) + (inter (match-string 3 method-str)) + (method (match-string 4 method-str)) + class var2) + (cond + ;; [this->] Method() or field initialization or constructor call + ((null method) + (or (string-match "[.]cdl" (or buffer-file-name (buffer-name))) + (setq var2 (list "Create" object nil "Create" nil object ))) + (setq class (eap-class-name (or buffer-file-name (buffer-name)))) + (setq method object + object nil) + ) + ;; new|return Class() or return this->Method() + ((string-match "^\\(new\\|return\\)$" object) + (if (string= "return" object) + (setq var2 (list method nil (eap-class-name)))) + (setq class method + object nil + method "Create") + ) + ((null inter) + ;; Obj_Class anObj() or RetVal_Class Method() + ;; first variant + (setq class object + object nil) + (if (and (string-match "[.]hx*$" (or buffer-file-name "")) + (setq class (eap-class-name))) + (if (string= class method) + (setq method "Create")) + (setq var2 (list method nil (eap-class-name))) + (setq method "Create")) + ) + ;; object.Method() or object->Method() + ((string-match "[.>-]" inter) + ;; nothing to change + ) + ;; Class::Method() + ((string= "::" inter) + (setq class object + object nil) + (if (string= class method) + (setq method "Create")) + ) + ;; obj = this->Method() or obj = Create_Obj() + ((string= "=" inter) + (setq var2 (list "Create" nil method "Create" object nil)) ;; second variant + (setq object nil + class (eap-class-name)) + ) + ) + (append (list method object class) var2))) + ) +(defun eap-method-call-string (&optional endPos) + "Return method call string" + (let* ((cdl-p (string-match "[.]cdl" (or buffer-file-name (buffer-name)))) + not-in-comment beg end str) + (save-excursion + (skip-syntax-forward "w_");; reach end of either object or method + (and (not cdl-p) + (looking-at "[ \t\n]*\\(->\\|[.]\\|::\\)[_a-zA-Z0-9]+") + (goto-char (match-end 0)) + ) + (setq end (point)) + (skip-syntax-backward "^w") + (or cdl-p + (setq not-in-comment (not (eap-in-comment)))) + (skip-syntax-backward "w_") ;; may be method + (setq beg (point)) + (skip-chars-backward "->:.= \t\n") + (and (not cdl-p) + (looking-at "[ \t\n]*\\(->\\|[.]\\|::\\)?[ \t\n]*[_a-zA-Z0-9]+") + (eq not-in-comment (not (eap-in-comment))) + (skip-syntax-backward "w_") ;; object + (save-excursion + (beginning-of-line) + (not (looking-at "[ \t]*#"))) ;; not preprocessor instruction + (setq beg (point))) + ) + (setq str (eap-simplify-string (buffer-substring end beg) '(("\t\n" " ")))) + (if endPos (cons str end) str) + ) + ) +(defvar method-search-in-cur-re + (list + (list 'c++-mode + "^\\([ \t_(a-zA-Z0-9]+\\w[ \t)&*]*\\)?[ \t]*[_a-zA-Z0-9]+[ \t\n]*::[ \t\n]*%s[ \t\n]*([^{;]+{" + "^[ \t_(a-zA-Z0-9]+\\w[ \t\n)&*]+%s[ \t\n]*(" ) + (list 'cdl-mode + "^[\t ]*%s\\s *\\((\\s *[a-zA-Z]\\|returns\\s +\\)" ) + (list 'ccl-mode + "^\\s *(\\s *def[a-z]+\\(-constant\\)? +%s\\( \\|(\\|\n\\|\t\\)" ) + (list 'c-mode + "[-_a-zA-Z0-9]+ +%s *([^)]*)[\t\n ]*\\({\\|\\w\\)" ) + (list 'tcl-mode + "^\\s *proc %s[\t\n {]" ) + ) + "*Alist mapping major-mode to list of regexps for search for given method definition. +A regexp should contain %s format control-string to be replaced with method name. +Search is case sensitive. + +Default regexps for c++-mode would find class method definition or anything looking +like method definition or declaration" + ) +(defun eap-find-method-in-current (methodName &optional from-cur-pt) + "Look for method METHODNAME definition in current buffer +starting from buffer beginning or from current position \(if FROM-CUR-PT). +Move point at definition beginning and return this position. + +Actually it looks for regexp associated with major-mode in +'method-search-in-cur-re and return \(match-beginning 0). If none regexp is +associated, regexp for elisp def[un,var,..] is searched" + (let* ((re-list (or (cdr (assq (or (eap-file-mode) major-mode) method-search-in-cur-re)) + (list "^\\s *(\\s *def[a-z]+ +%s\\( \\|(\\|\n\\|\t\\)"))) ;; e-lisp + case-fold-search + regexp pt) + (save-excursion + (or from-cur-pt + (goto-char (point-min))) + (while (and (null pt) re-list) + (setq regexp (format (car re-list) methodName) + re-list (cdr re-list)) + (while (and (re-search-forward regexp nil t) + (setq pt (match-beginning 0)) + (eap-quit-comment)) + (setq pt nil)) + )) + (if pt + (goto-char pt))) + ) +(defun eap-method-name (method-fullstring &optional mode) + (if (stringp method-fullstring) + (let* (name + (meth-str method-fullstring) + (match 1) + (mode (or mode (eap-file-mode))) + (regexp (cond + ((equal mode 'c++-mode);; + (setq meth-str (eap-replace-all "Handle[ \t\n]*(" "Handle_" meth-str )) + "\\([_a-zA-Z0-9]+\\)[ \t\n]*(") + ((equal mode 'c-mode) "\\([-_a-zA-Z0-9]+\\) *(") + ((equal mode 'cdl-mode) "^\\s *\\([a-zA-Z0-9]+\\)") + ((equal mode 'ccl-mode) + (setq match 2) + "( *def[a-z]+\\(-constant\\)? *\\([-_a-zA-Z0-9]+\\)") + ((equal mode 'tcl-mode) + "proc\\s +\\([^ {\n]+\\)") + (t "( *def[a-z]+ \\([-_a-zA-Z0-9]+\\)")))) + (and (string-match regexp meth-str) + (setq name (match-string match meth-str)) + (if (string-match (format " %s *::" name) meth-str) + (setq name "Create") t) + name))) + ) +(defun method-search-key() + (global-set-key [?\C-,] 'eap-next-method-backward) + (global-set-key [?\C-.] 'eap-next-method) + ) + +(provide 'method-search) diff --git a/src/WOKsite/public_el/my_csf.el b/src/WOKsite/public_el/my_csf.el new file mode 100644 index 0000000..2825ea7 --- /dev/null +++ b/src/WOKsite/public_el/my_csf.el @@ -0,0 +1,154 @@ +(if (string-match "Emacs 22" (emacs-version)) + (progn + (setq show-paren-delay 0.5) + (setq fill-column 78) + (custom-set-variables + '(font-lock-maximum-size (quote ((t . 20000000)))) + '(font-lock-maximum-decoration (quote ((t . 2) (sgml-mode . 3)))) + ) + (set-scroll-bar-mode 'right) + (put 'scroll-bar-width 'x-frame-parameter 10) + ) +) + +(load "faces") + +;; csf/emacs in the load-path +(setq load-path (cons (concat (getenv "WOKHOME") "/lib") load-path)) +(if (not (boundp 'woksh)) + (progn + (load-library "woksh") + ) +) + +(global-set-key (quote [home]) (quote beginning-of-buffer)) +(global-set-key (quote [end]) (quote end-of-buffer)) +(global-set-key " " (quote kill-this-buffer)) +(global-set-key (quote [f2]) (quote save-buffer)) +(global-set-key (quote [f3]) (quote find-file-at-point)) +(global-set-key (quote [f4]) (quote ediff-buffers)) +(global-set-key (quote [f5]) (quote goto-line)) +(global-set-key (quote [S-f5]) (quote jump-to-register)) +(global-set-key (quote [C-S-f5]) (quote point-to-register)) +(global-set-key (quote [f6]) (quote font-lock-mode)) +(global-set-key (quote [f7]) (quote blink-matching-open)) +(global-set-key (quote [f8]) (quote find-alternate-file)) +(global-set-key (quote [f9]) (quote compile)) +(global-set-key (quote [C-tab]) (quote tab-to-tab-stop)) +(global-set-key (quote [C-g]) (quote keyboard-quit)) +(global-set-key " " (quote agv-indent-by-tab)) +(global-set-key " " (quote agv-indent-by-space)) + +(auto-compression-mode 1) +(set-language-environment "Latin-1") +(show-paren-mode t) + +(defun csf-fortran-mode-init() + (setq font-lock-maximum-decoration 2) + (font-lock-mode 1)) + +(defun csf-c-mode-init() + (setq font-lock-maximum-decoration 2) + (font-lock-mode 1)) + +(defun agv-indent-by-space () + (interactive) + (setq indent-tabs-mode nil)) + +(defun agv-indent-by-tab () + (interactive) + (setq indent-tabs-mode t)) + +(defun agv-toggle-c-mode () + (interactive) + (if (string-equal mode-name "C++") + (c-mode) + (if (string-equal mode-name "C") (c++-mode)))) + +; project specific settings +(load-library "csf-cdl-mode") +;(load-library "csf-c++-mode") +(load "occ-c++-mode") +(occ-header-key) ;C-c f1 +(occ-set-c++-file-header) + +(setq auto-mode-alist (cons (cons "\\.cpp$" 'c++-mode) auto-mode-alist)) +(setq auto-mode-alist (cons (cons "\\.cxx$" 'c++-mode) auto-mode-alist)) +(setq auto-mode-alist (cons (cons "\\.lxx$" 'c++-mode) auto-mode-alist)) +(setq auto-mode-alist (cons (cons "\\.ixx$" 'c++-mode) auto-mode-alist)) +(setq auto-mode-alist (cons (cons "\\.gxx$" 'c++-mode) auto-mode-alist)) +(setq auto-mode-alist (cons (cons "\\.pxx$" 'c++-mode) auto-mode-alist)) +(setq auto-mode-alist (cons (cons "\\.cdl$" 'cdl-mode) auto-mode-alist)) +(setq auto-mode-alist (cons (cons "\\.edl$" 'edl-mode) auto-mode-alist)) + +(autoload 'cdl-mode "cdl-mode") +(autoload 'edl-mode "edl-mode") + +(add-hook 'cdl-mode-hook 'csf-cdl-mode-init) +(add-hook 'c-mode-hook 'csf-c-mode-init) +(add-hook 'c++-mode-hook 'csf-c++-mode-init) +(add-hook 'fortran-mode-hook 'csf-fortran-mode-init) + +(if (string-match "Emacs 22." (emacs-version)) +;; Emacs.22 customisation + (progn + (defface font-lock-builtin-face + '((((class grayscale) (background light)) (:foreground "LightGray" :bold t)) + (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) + (((class color) (background light)) (:foreground "CadetBlue")) + (((class color) (background dark)) (:foreground "LightSteelBlue")) + (t (:bold t))) + "Font Lock mode face used to highlight builtins." + :group 'font-lock-highlighting-faces) + (defface font-lock-type-face + '((((class grayscale) (background light)) (:foreground "Gray90" :bold t)) + (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) + (((class color) (background light)) (:foreground "ForestGreen" :italic t)) + (((class color) (background dark)) (:foreground "PaleGreen")) + (t (:bold t :underline t))) + "Font Lock mode face used to highlight type and classes." + :group 'font-lock-highlighting-faces)) + +;; Emacs.19 customisation + (setq font-lock-face-attributes + '((font-lock-comment-face "Firebrick") + (font-lock-string-face "RosyBrown") + (font-lock-keyword-face "Purple") + (font-lock-function-name-face "Blue") + (font-lock-variable-name-face "DarkGoldenrod") + (font-lock-type-face "DarkGreen") + (font-lock-reference-face "CadetBlue")))) + +(defvar ps-paper-type 'ps-a4 + "*Specifies the size of paper to format for. Should be one of +`ps-letter', `ps-legal', or `ps-a4'.") +(defvar ps-left-margin 72) ; 1 inch +(defvar ps-right-margin 24) ; 1/3 inch +(defvar ps-bottom-margin 36) ; 1/2 inch +(defvar ps-top-margin 36) ; 1/2 inch +(defvar ps-font-size 7 + "*Font size, in points, for generating Postscript.") + +(defvar ps-avg-char-width (if (fboundp 'float) 4.5 5.35) + "*The average width, in points, of a character, for generating Postscript. +This is the value that ps-print uses to determine the length, +x-dimension, of the text it has printed, and thus affects the point at +which long lines wrap around. If you change the font or +font size, you will probably have to adjust this value to match.") + +(defvar ps-space-width (if (fboundp 'float) 4.5 5.35) + "*The width of a space character, for generating Postscript. +This value is used in expanding tab characters.") + +(defvar ps-line-height (if (fboundp 'float) 8.1 8) + "*The height of a line, for generating Postscript. +This is the value that ps-print uses to determine the height, +y-dimension, of the lines of text it has printed, and thus affects the +point at which page-breaks are placed. If you change the font or font +size, you will probably have to adjust this value to match. The +line-height is *not* the same as the point size of the font.") + +;(add-hook 'shell-mode-hook 'cv5-shell-mode) +;(defun cv5-shell-mode () +;; (load-library "cv5") +;) diff --git a/src/WOKsite/public_el/occ-c++-mode.el b/src/WOKsite/public_el/occ-c++-mode.el new file mode 100644 index 0000000..f08cbc3 --- /dev/null +++ b/src/WOKsite/public_el/occ-c++-mode.el @@ -0,0 +1,82 @@ +;;;File :occ-c++-mode.el +;;;Author :MSV +;;;Purpose :Emacs adjustments for project OCC + +(defun occ-set-c++-file-header () + "Sets OCC style header at beginning of a C++ buffer" + (interactive) + (defun c++-file-header () + "insert a header at beginning of buffer" + (interactive) + (beginning-of-buffer) + + (insert "// File: " (buffer-name)) + (insert "\n// Created: " (format-time-string "%d.%m.%y %H:%M:%S")) + (insert "\n// Author: " (concat (user-login-name) "@" (system-name))) + (insert "\n// Copyright: Open CASCADE " (format-time-string "%Y") "\n")) + (setq current-c++-file-header 'occ-set-c++-file-header) + (message "OCC style C++ header is set")) + +(defun c++-new-file-header () + "insert a header at beginning of buffer" + (interactive) + (c++-file-header) + + (cond + ((string-match "\\.hxx$" (buffer-name)) + (let* ((classname (substring (buffer-name) 0 -4)) + (headername (concat classname "_HeaderFile"))) + (insert "\n#ifndef " headername) + (insert "\n#define " headername) + (insert "\n\n#include \n") + (insert "\n// Block of comments describing class " classname "\n//\n") + (insert "\nclass " classname " ") (setq p (point)) + (insert "\n{\npublic:") + (insert "\n // ---------- PUBLIC METHODS ----------\n") + (insert "\n " classname "() {}") + (insert "\n // Empty constructor\n") + (insert "\n Standard_EXPORT " classname "(const " classname "& theOther);") + (insert "\n // Copy constructor\n") + (insert "\n Standard_EXPORT virtual ~" classname "();") + (insert "\n // Destructor\n") + (insert "\n\n\nprotected:") + (insert "\n // ---------- PROTECTED METHODS ----------\n") + (insert "\n\n\nprivate:") + (insert "\n // ---------- PRIVATE FIELDS ----------\n") + (insert "\n\n\npublic:") + (insert "\n // Declaration of CASCADE RTTI") + (insert "\n //DEFINE_STANDARD_RTTI(" classname ")") + (insert "\n};\n") + (insert "\n// Definition of HANDLE object using Standard_DefineHandle.hxx") + (insert "\n//DEFINE_STANDARD_HANDLE(" classname ", )\n") + (insert "\n#endif\n") + (goto-char p))) + + ((string-match "\\.cxx$" (buffer-name)) + (let ((classname (substring (buffer-name) 0 -4))) + (insert "\n#include <" classname ".hxx>\n") + (insert "\n//=======================================================================") + (insert "\n//function : " classname) + (insert "\n//purpose : Constructor") + (insert "\n//=======================================================================\n\n") + (insert classname "::" classname "()") (setq p (point)) + (insert "\n{\n}\n") + (goto-char p))) + )) + +(occ-set-c++-file-header) + +(defun csf-c++-mode-init () + (abbrev-mode 1) + (if (zerop (buffer-size)) ; insert in new files + (c++-new-file-header)) + (setq font-lock-maximum-decoration 2) + (font-lock-mode 1) + (setq indent-tabs-mode nil) + (if (string-match "Emacs 21" (emacs-version)) + (c-set-style "OCC")) + (setq c-continued-brace-offset -2) ;; for "{" style + (funcall current-c++-file-header)) + +(defun occ-header-key () + (define-key mode-specific-map [f1] 'occ-set-c++-file-header)) diff --git a/src/WOKsite/public_el/rename.el b/src/WOKsite/public_el/rename.el new file mode 100644 index 0000000..0561f83 --- /dev/null +++ b/src/WOKsite/public_el/rename.el @@ -0,0 +1,352 @@ +;;;File :rename.el +;;;Author :Edward AGAPOV +;;;Purpose :rename files modifing Dired buffer contents +;;;History :Mon Nov 30 09:28:45 1998 Edward AGAPOV Creation + +(require 'hilit19) + +(defvar rename-source-buf nil + "Original Dired buffer" + ) + +(defun rename-in-dired () + "Rename files modifing Dired buffer contents" + (interactive) + (let* ((bn (buffer-name)) + (cb (current-buffer)) + (new-name (concat " " bn)) + (cont (buffer-string)) + (new-buf (get-buffer-create " rename-work-buffer")) + (pt (point)) + ) + (rename-buffer new-name) + (switch-to-buffer new-buf) + (or (local-variable-p 'rename-source-buf) + (rename-mode)) + (setq rename-source-buf cb) + (message "Prepare buffer for renaming files ...") + (let ((inhibit-read-only t) + after-change-functions before-change-functions) + (erase-buffer) + (insert cont) + (rename-copy-hiliting);;(hilit-rehighlight-buffer t) + (rename-protect-non-names) + (goto-char pt) + (rename-buffer bn) + ) + (setq buffer-undo-list nil) + (message "After file names edition, type 'M-r' to actually rename files" ) + ) + ) +(defun rename-mode () + "Mode for renaming any number of files at once. +Allow modifing file names right in Dired buffer. +Type 'M-r to save changes i.e. rename files. +Type 'C-g to quit without saving" + (make-local-variable 'rename-source-buf) + (setq mode-line-buffer-identification '("Dired: %17b")) + (let ((tmp-map (make-keymap))) + (define-key tmp-map "\M-r" 'rename-save) + (define-key tmp-map "\C-g" '(lambda() + "Quit without renaming" + (interactive) + (setq buffer-undo-list nil) + (rename-save))) + (define-key tmp-map [return] 'next-line) + (use-local-map tmp-map) + (setq mode-name "Rename") + (setq major-mode 'rename-mode) + (if (eq 'not (car hilit-mode-enable-list)) + (setq hilit-mode-enable-list (delete 'rename-mode hilit-mode-enable-list)) + (add-to-list 'hilit-mode-enable-list 'rename-mode)) + ;; copy patterns of dired-mode + (add-to-list 'hilit-patterns-alist + (cons 'rename-mode (cdr (assq 'dired-mode hilit-patterns-alist)))) + (set (make-local-variable 'after-change-function) nil) + (make-local-variable 'after-change-functions) + (add-hook 'after-change-functions 'rename-rehilit-changes) + (run-hooks 'rename-mode-hooks) + )) + +(defun rename-rehilit-changes (&rest args) + (save-excursion + (let* ((beg (progn (goto-char (car args)) + (beginning-of-line) + (1- (point)))) + (end (progn (goto-char (nth 1 args)) + (end-of-line) + (1+ (point))))) + (hilit-rehighlight-region (max beg (point-min)) + (min end (point-max)) + t))) + ) +(defun rename-copy-hiliting () + "Copy overlays instead of hitiling buffer" + (let ((ovl-end 1) ovl ovl-copy ovl-list) + (while (save-excursion + (set-buffer rename-source-buf) + (setq ovl nil) + (while (and (null ovl) + (setq ovl-end (next-overlay-change ovl-end)) + (setq ovl-list (overlays-at ovl-end))) + (mapcar '(lambda (ovr) + (and (overlay-get ovr 'hilit) + (setq ovl ovr + ovl-end (overlay-end ovr)))) + ovl-list)) + ovl) + (setq ovl-copy (make-overlay (overlay-start ovl) ovl-end)) + (overlay-put ovl-copy 'face (overlay-get ovl 'face)) + )) + ) +(defun rename-protect-non-names () + "Set read-only property to all buffer except file names" + (let ((beg 1) end) + (goto-char beg) + (while (/= beg (progn + ;;same as (dired-goto-next-nontrivial-file) + (while (and (not (eobp)) + (if (dired-move-to-filename) + (looking-at "\\.\\.?$") + 'go-on)) + (forward-line 1)) + (setq end (1- (point))))) + (put-text-property beg end 'read-only t) + (forward-line) + (setq beg (1- (point))) + )) + ) +(defmacro rename-prepend (lft seq &optional as-list) + "Prepend LFT to SEQ \(list) that must be '\(nil) at least" + `(progn (if (car ,seq) (setcdr ,seq (cons (car ,seq) (cdr ,seq)))) + (if (or (not (listp ,lft)) + (not ,as-list)) + (setcar ,seq ,lft) + (setcar ,seq (car ,lft)) + (setcdr ,seq (append (cdr ,lft) (cdr ,seq))))) + ) +(defmacro rename-append (lft seq &optional as-list) + "Append LFT to SEQ \(list) that must be '\(nil) at least. +LFT can be a list" + `(if (car ,seq) + (setcdr ,seq (append (cdr ,seq) + (if (and ,as-list (listp ,lft)) ,lft (list ,lft)))) + (if (or (not (listp ,lft)) + (not ,as-list)) + (setcar ,seq ,lft) + (setcar ,seq (car ,lft)) + (setcdr ,seq (cdr ,lft)))) + ) +(defmacro rename-delete (lft seq) + "Remove LFT from SEQ \(list) if it is member, return nil if it is not" + `(let ((rename-list (member ,lft ,seq))) + (if rename-list + (let* ((rename-len (length rename-list)) + (rename-seq-len (length ,seq)) + ) + (if (/= rename-len rename-seq-len) + (let ((rename-prev-list + (member (nth (- rename-seq-len rename-len 1) ,seq) ,seq))) + (setcdr rename-prev-list (cdr rename-list))) + ;; remove car + (setcar ,seq (nth 1 ,seq)) + (setcdr ,seq (nthcdr 2 ,seq)) + )))) + ) + +(defun rename-save () + "Perform renaming after file names modification" + (interactive) + (let ((total-ln-nb (count-lines 1 (point-max))) + (nb-renamed 0) + ln from to ; line-nb, old and new file name (full-name) + lft ; list of and , basic data item + ;;; line number is used as identifier of single rename action + ;;; because it is more relevant for quicker search in list + all-lft-list ; list of all s to process + free-lft ; list of s whos execution order doesn't matter + bound-lft-list ; list of lft sequences, each being a list of lft in + ;;; order of renaming that does metter + err ) + (setq bound-lft-list (list (list)) + free-lft (list (list)) + all-lft-list (list (list))) + (if (/= total-ln-nb + (save-excursion + (set-buffer rename-source-buf) + (count-lines 1 (point-max)))) + (error "Can't rename files if number of lines changed")) + (while buffer-undo-list + (setq lft + (rename-lft-by-undo (car buffer-undo-list) all-lft-list)) + (setq buffer-undo-list (cdr buffer-undo-list)) + (and lft + ;; find other s with other-from== and other-to== + (let ((ft-list (mapcar 'cdr all-lft-list)) + to-coinc-lft from-coinc-lft) + (setq from (nth 1 lft) + to (nth 2 lft)) + (if (rassoc (list to) ft-list) + nil ;; skip this line if same already encountered + (setq from-coinc-lft (rassoc (assoc to ft-list) all-lft-list)) + (setq to-coinc-lft (rassoc (rassoc (list from) ft-list) all-lft-list)) + (if from-coinc-lft + (rename-bind from-coinc-lft lft from-coinc-lft bound-lft-list free-lft)) + (if to-coinc-lft + (rename-bind lft to-coinc-lft to-coinc-lft bound-lft-list free-lft)) + (or to-coinc-lft from-coinc-lft + (rename-append lft free-lft)) + (rename-append lft all-lft-list) + ) + )) + );; end loop on buffer-undo-list + + ;; make one list appending bound-lft-list to free-lft + (mapcar '(lambda (bnd-group) + (setq free-lft (append free-lft bnd-group))) + bound-lft-list) + ;; do renaming + (rename-buffer " rename-work-buffer") + (switch-to-buffer rename-source-buf) + (rename-buffer (substring (buffer-name) 1)) + (mapcar '(lambda (lft) + (if (null (car lft)) + nil + (setq ln (nth 0 lft) + from (nth 1 lft) + to (nth 2 lft)) + (condition-case err + (let ((actual-marker-char (dired-file-marker from)) + (ovwr (file-exists-p to))) + ;;(message "%s -> %s" from to) + (if (= 0 ln) + (dired-goto-file from) + (goto-line ln)) + (dired-rename-file from to 4) + (if ovwr + (dired-remove-file to)) + (dired-add-file to actual-marker-char) + (if (/= 0 ln) + (setq nb-renamed (1+ nb-renamed))) + ) + (error (message "%s" err)(sit-for 1.5)) + ))) + free-lft) + (or err + (message "%d files renamed" nb-renamed)) + )) +(defun rename-lft-by-undo (undo already-list) + "Return \(list ), if file name modificaton is recorded in UNDO. +UNDO is a member of buffer-undo-list" + (let* ((pos (if (stringp (car-safe undo)) + (abs (cdr undo)) + (if (numberp (car-safe undo)) + (car undo)))) + (line (if pos (count-lines 1 pos))) + from to col from-dir add-bad lft + buffer-undo-list ;; protect actual undo list being iterated + ) + (and pos + (not (assoc line already-list)) + (setq add-bad t) ; if the following ckecks are not successfully passed, + ;;; add current line to as checked + ;; get + (save-excursion + (set-buffer rename-source-buf) + (goto-line line) + (dired-move-to-filename) + (setq col (current-column)) + (setq from-dir (dired-current-directory)) + (setq from (rename-get-file-name)) + ) + ;; new name must begin at the same column as the old one + (goto-char pos) + (<= col (current-column)) + (move-to-column col) + (= (char-after (1- (point))) ? ) ;;whitespace + ;; get + (setq to (rename-get-file-name)) + ) + (primitive-undo 1 (list undo)) + (setq lft (list line (concat from-dir from) (concat from-dir to))) + (and (null to) + add-bad + (rename-append already-list lft)) + (if to lft) + )) +(defun rename-get-file-name () + "Return buffer-substring from point till file name end" + (let* ((beg (point)) + (end (progn (re-search-forward "\\([ \t]*[\n\r]\\)\\|\\( -> \\)" nil t) + (match-beginning 0)))) + (if (< beg end) + (buffer-substring-no-properties beg end)) + )) + +;;; lft is alist of +;;; all args are lft or lists of lft +(defun rename-bind (fr-coin to-coin old-lft bound-list free) + "Assure renaming in proper order when
and coincide. +Put new lft to BOUND-LIST. Lft with coinciding is prepended to +some sequence to be performed earlier than it's pair lft that is +appended to the same sequence of BOUND-LIST" + (let* ((old-was-free (rename-delete old-lft free)) + (bnd-list bound-list) + fr-bound-group ; list already containing + to-bound-group ; list already containing + ) + ;; look for bound groups containing old and may be new lft + (while (car bnd-list) + (let* ((group (car bnd-list))) + (setq bnd-list (cdr bnd-list)) + (if (member fr-coin group) + (setq fr-bound-group group)) + (if (member to-coin group) + (setq to-bound-group group)) + ;; stop searching? + (or (null bnd-list) + (if old-was-free + (if (or fr-bound-group to-bound-group) + (setq bnd-list nil)) + (if (and fr-bound-group to-bound-group) + (setq bnd-list nil))) + ) + )) + ;; binding + (cond ((null (or fr-bound-group to-bound-group)) + (let ((new-group (list fr-coin to-coin))) + (rename-append new-group bound-list) + )) + ((and fr-bound-group to-bound-group) + (if (eq fr-bound-group to-bound-group) + ;; case a->b b->a, bind tmp ltf (b->tmp): b->tmp a->b tmp->a + ;; here a->b -- to-coin, b->a -- fr-coin + (let* ((dir (file-name-directory (nth 1 to-coin))) + (from (nth 2 to-coin)) + (tmp-to (format ".__%d__" (nth 2 (current-time)))) + (tmp-from-lft (list 0 from (concat dir tmp-to)))) + (setcdr fr-coin (list (concat dir tmp-to) (nth 2 fr-coin))) + (rename-prepend tmp-from-lft fr-bound-group) + ) + (rename-delete fr-bound-group bound-list) + (rename-prepend fr-bound-group to-bound-group 'as-list) + )) + (fr-bound-group + (rename-append to-coin fr-bound-group) + ) + (to-bound-group + (rename-prepend fr-coin to-bound-group) + ) + (t + (error "rename-bind: group analys") + )) + ) + ) +(defun rename-key () + (add-hook 'dired-mode-hook ;;dired-load-hook ;; + '(lambda () + (define-key dired-mode-map "\M-r" 'rename-in-dired))) + ) + + +(provide 'rename) diff --git a/src/WOKsite/public_el/shared.el b/src/WOKsite/public_el/shared.el new file mode 100644 index 0000000..cb8eeb5 --- /dev/null +++ b/src/WOKsite/public_el/shared.el @@ -0,0 +1,875 @@ +;;; shared.el --- common use functions + +;;;Author :Edward AGAPOV +;;;History :Thu Mar 9 2000 Creation + +(defvar eap-animation nil + "*Turn on and off animation effect when scrolling buffer. +Default is nil \(off) because is not well tested and needs improvement" + ) + +(defvar eap-enable-remember-visited nil + "*Switch on and off storage of names of visited files in a buffer. +The buffer name is given by 'eap-visited-files-buf-name variable +(*visited-files* by default). +'eap-show-visited-files displays that buffer." + ) + +(defun eap-chk-load-path () + "Remove doubling paths in 'load-path and make it contain true file names" + (let ((lp (mapcar 'file-truename load-path))) + (setq load-path nil) + (mapcar '(lambda (f) + (add-to-list 'load-path f)) + lp)) + ) +(eap-chk-load-path) + +(or (getenv "USER") + (setenv "USER" (getenv "USERNAME")) ;; for WNT + ) +(setenv "HOME" (if (getenv "HOME") + (directory-file-name (file-truename (getenv "HOME"))))) +(defun eap-home () + (concat (getenv "HOME") "/")) + +(defun eap-load-all-el (where &optional forced-p match fun) + "Load all or matching regexp MATCH emacs lisp files found in WHERE. +Add WHERE to 'load-path. +If not FORCED-P, a file is loaded only if corresponding feature is not yet provided. +FUN is called for loaded file name." + (and (file-exists-p where) + (file-directory-p where) + (let* ((files (directory-files where nil "[.]el$")) + (dir (file-truename where)) + file) + (setq load-path (mapcar 'file-truename load-path)) + (and files + (add-to-list 'load-path dir)) + (while files + (setq file (file-name-sans-extension (car files)) + files (cdr files)) + (and (or forced-p + (not (member (intern file) features))) + (or (null match) + (string-match match file)) + (load file) + fun + (funcall fun file)) + ) + )) + ) +(defun eap-bind-key (library) + "call \(LIBRARY-key) function" + (let ((fun (intern (concat library "-key")))) + (if (fboundp fun) + (funcall fun))) + ) +(defun eap-bug-report () + "Put info about place where failure occures and CSF env vars in clipboard" + (interactive) + (kill-new + (concat + "\n" (or buffer-file-name (buffer-name)) + ":" (count-lines (point-min) (point)) "\n" + (point) "\n" + "csf-shop-adm-path: " (if (boundp 'csf-shop-adm-path) csf-shop-adm-path "-") "\n" + "csf-ref-list: " (if (boundp 'csf-ref-list) (format "%s" csf-ref-list) "-") "\n" + "load-path: " (format "%s" load-path) "\n" + )) + (message "Call it right after failure occures. Ok, environment copied") + ) + +(eval-when-compile + (require 'hilit19)) +(defun eap-rehighlight-changes (&rest args) + "Rehilit changed text" + (save-excursion + ;;(message "%s %s %s" (car args) (nth 1 args) (nth 2 args)) + (let* ((beg (progn (goto-char (car args)) + (beginning-of-line -1) + (point))) + (end (progn (goto-char (nth 1 args)) + (end-of-line 2) + (point))) + ) + (setq beg (apply 'min beg (mapcar 'overlay-start (overlays-at beg)))) + (setq end (apply 'max end (mapcar 'overlay-end (overlays-at end)))) + (hilit-unhighlight-region beg end 'quietly) + (or (= beg (point-min)) + (setq beg (1- beg))) + (or (= end (point-max)) + (setq end (1+ end))) + (hilit-highlight-region beg end nil 'quietly))) + ) + +(defun eap-kill-line (&optional dont-copy) + "Kill and copy \(without prefix argument\\) a whole line." + (interactive "P*") + (let* ((beg (or (beginning-of-line) (point))) + (end (and (forward-line) (point)))) + (if dont-copy + (delete-region beg end) + (kill-region beg end))) + ) +(defun eap-extention (file &optional pos) + "Return extention or it's beginning position if POS is not nil" + (let* ((file (if file (file-name-sans-versions file)))) + (if (and file (string-match "\\w\\.\\(\\w+\\)$" file)) + (if pos + (match-beginning 1) + (substring file (match-beginning 1))))) + ) +(defun eap-make-extention (fileName ext) + "Replace existing extention with \(or just append\) new one." + (let* ((f fileName) + (pos (eap-extention fileName 'pos))) + (if pos + (setq f (substring f 0 pos)) + (or (string-match "\\.$" f) + (setq f (concat f ".")))) + (concat f ext)) + ) +(defun eap-n-level-up (dir &optional level noslash div-str) + "Remove LEVEL components of path DIR +Remove components from left if LEVEL is negative. +NOSLASH removes last divider from result. +DIV-STR gives components divider, defaults to \"/\"." + (let* ((path dir) + (divider (or div-str "/")) + (counter (or level 1 ))) + (if (> counter 0) + (while (and (> (length path) 0) + (> counter 0)) + (setq counter (1- counter)) + (if (string-match (format "[^%s]+%s*$" divider divider) path) + (setq path (substring path 0 (match-beginning 0))))) + (while (and (> (length path) 0) + (< counter 0)) + (setq counter (1+ counter)) + (if (string-match (format "[^%s]+" divider) path) + (setq path (substring path (match-end 0)))))) + (if noslash + (if (and level + (< level 0) + (= 0 (string-match divider path))) + (setq path (substring path 1)) + (if (string-match (format "%s$" divider) path) + (setq path (substring path 0 (match-beginning 0)))))) + path) + ) +(defun eap-class-name (&optional file with-number) + "Returns file-name without path, extention and version \(if not WITH-NUMBER)" + (let* ((file (or file buffer-file-name (buffer-name) default-directory "")) + (cl-name (file-name-sans-extension (file-name-nondirectory file))) + ) + (if with-number + cl-name + (eap-replace-all "_[a-z0-9]+\\(_[a-z0-9]+\\)$" "" cl-name 1) + )) + ) +(defun eap-get-package-name (fullName) + "Return package component of FULLNAME. +FULLNAME may be either path or class name" + (if (stringp fullName) + (let* ((path (file-name-directory fullName)) + (name (file-name-nondirectory fullName))) + (if (and path + (not (string-match "BAG" path)) + (string-match "[/\]src[/\]" path)) + (if (string-match "src[/\]$" path) + name;; case: path/src/file -> file = pack + (substring path (match-end 0) -1)) + (if (string-match + "\\(_\\|[.]toolkit\\|[.]package\\|\\.\\w+[^/]*$\\)" name) + (substring name 0 (match-beginning 0)) + name)))) + ) +(defun eap-cpp-style (aclass) + "Make from " + (let* (packname classname) + (if (string-match " +in +" aclass) + (setq aclass (substring aclass 0 (match-beginning 0))) + ) + (if (string-match "[ \t\n]+from[ \t\n]+" aclass) + (setq packname (substring aclass (match-end 0)) + classname (substring aclass 0 (match-beginning 0))) + (setq packname aclass + classname nil) + ) + (concat (eap-simplify-string packname '((" "))) + (if classname (concat "_" (eap-simplify-string classname '((" "))))) + )) + ) + +(defun eap-file-mode (&optional fileName list-p) + "Return the mode corresponding to the FILENAME or buffer-file-name. +Return a list of corresponding modes, if LIST-P" + (let* ((file (if fileName fileName (or (buffer-file-name) (buffer-name)))) + (file (file-name-sans-versions file)) + (alist auto-mode-alist) + (mode nil) mode-list) + (while (and (or list-p (not mode)) + alist) + (and (string-match (car (car alist)) file) + (setq mode (cdr (car alist))) + (not (member mode mode-list)) + (setq mode-list (append mode-list (list mode)))) + (setq alist (cdr alist))) + (if list-p + mode-list + mode)) + ) +(defun eap-file-is-mine (file &optional my-file) + "Compare UID of FILE with one of MY-FILE or HOME dir" + (condition-case nil + (= (nth 2 (file-attributes (or my-file (eap-home)))) + (nth 2 (file-attributes file))) + (error nil)) + ) +(defun eap-file-newer-p (newer other) + (let ((new-time (nth 5 (file-attributes newer))) + (other-time (nth 5 (file-attributes other))) + ) + (if (or (null other-time) + (null new-time)) + nil + (or (> (car new-time) (car other-time)) + (if (= (car new-time) (car other-time)) + (> (nth 1 new-time) (nth 1 other-time))) + ))) + ) +(defun eap-current-file (&optional any) + "Find current file under different major-modes. +If ANY, return 'default-directory at least" + (let* ((file (or buffer-file-name + (car (eap-dired-get-marked-files)) + (progn (set-buffer (or (if Buffer-menu-buffer-column + (Buffer-menu-buffer nil)) + (current-buffer))) + (or buffer-file-name default-directory)) + )) + ) + (if (and file + (or any + (not (file-directory-p file)))) + (expand-file-name file) + )) + ) +(defun eap-find-file-noselect (file &optional existing any-existing-p) + "Read FILE into a buffer and return the buffer. +Set 'buffer-file-name, 'default-directory and 'major-mode. +If EXISTING, first try to find buffer visiting FILE. +If ANY-EXISTING-P, also try to find buffer named as one visiting FILE would be named. +Run 'eap-find-file-hooks" + (save-excursion + (or (if existing (or (find-buffer-visiting file) + (if any-existing-p (get-buffer (file-name-nondirectory file))))) + (let ((buf (set-buffer (create-file-buffer file))) + er) + (setq buffer-file-name file + default-directory (file-name-directory file) + major-mode (eap-file-mode file)) + (condition-case er + (if (file-exists-p file) + (if (file-directory-p file) + (progn (kill-buffer buf) + (setq buf (dired-noselect file))) + ;;(insert-file-contents-literally file) + (insert-file-contents file) + (goto-char 1) + )) + (error (message "eap-find-file-noselect error: %s" er))) + (run-hooks 'eap-find-file-hooks) + (set-buffer-modified-p nil) + buf + ) + )) + ) +(defun eap-find-file (file &optional existing any-existing-p) + "Switch to buffer returned by 'eap-find-file-noselect \(see)" + (switch-to-buffer (eap-find-file-noselect file existing any-existing-p)) + ) +(defun eap-dired-get-marked-files (&optional no-dir) + "Unlike dired-get-marked-files never causes errors but returns nil" + (if (equal major-mode 'dired-mode) + (let* ((localp (if no-dir 'no-dir nil)) + (marked + (save-excursion + (nreverse (dired-map-over-marks (dired-get-filename localp t) nil))))) + (while (string-match dired-trivial-filenames + (file-name-nondirectory + (or (car marked) ""))) + (setq marked (cdr marked))) + (if (equal marked '(nil)) + nil marked))) + ) +(defun eap-directory-files (directory &optional full match nosort msg) + "The same as 'directory-files plus check that all files are retrived. +If MSG not t, print 'MSG DIRECTORY: '. +Do not signal an error if DIRECTORY is not existent" + (if (file-exists-p directory) + (let* ((msg (if (eq msg t) + nil + (concat msg " " directory ": %d" ))) + (files (directory-files directory full match nosort)) + (nb (length files)) + (old-nb 0) + ) + (while (/= nb old-nb) + (if msg (message msg nb)) + (setq old-nb nb) + (setq files (directory-files directory full match nosort)) + (setq nb (length files)) + ) + files)) + ) +(defun eap-replace-all (obj with string &optional subexp) + "Replace all encounters of OBL with WITH in STRING. +OBL is considered to be regexp. +The optional fifth argument SUBEXP specifies a subexpression of the match +to be replaced." + (let* ((res string)) + (while (and (string-match obj res) + (if subexp (match-end subexp) t)) + (setq res (replace-match with nil nil res subexp))) + res) + ) +(defun eap-simplify-string (string how-list) + "Replace all text matched of car of HOW-LIST member with +optional nth 1 of HOW-LIST member. Optional nth 2 of HOW-LIST member +specifies a subexpression of the match to be replaced." + (let* ((how-list (if (atom (car how-list)) (list how-list) how-list)) + triple obj with) + (while (car how-list) + (setq triple (car how-list) + how-list (cdr how-list) + obj (car triple) + with (or (nth 1 triple) "") + string (eap-replace-all obj with string (nth 2 triple)))) + string) + ) +(defun eap-simplified-string (string) + "Replace TAB, RET with SPC, double SPC with single ones." + (eap-simplify-string string '(("[\t\n]" " ") (" +" " "))) + ) +(defmacro eap-no-prp (&rest body) + "Execute the BODY forms removing all properties from result" + `(let ((res (progn ,@body))) + (if (stringp res) + (set-text-properties 0 (length res) nil res)) + res) + ) +(defun eap-match-string (num &optional string) + "The same as 'match-string' but returns substring without properties" + (eap-no-prp (match-string num string)) + ) +(defun eap-current-word (&optional strict) + "The same as 'current-word but returned string has no properties" + (eap-no-prp (current-word strict)) + ) +(defun eap-count-lines (start end) + "Return number of lines between START and END. +Unlike 'count-lines return number of screen lines if \(not truncate-lines)" + (if (or truncate-lines + (and truncate-partial-width-windows + (< (window-width) (frame-width))) + ) + (1+ (count-lines start end)) + (save-excursion + (save-match-data + (let* ((nb 0) + (win-wid (window-width)) + (beg (min start end)) + (end (max start end)) + stop-p) + (goto-char beg) + (while (not stop-p) + (setq nb (+ nb 1 (/ (skip-chars-forward "^\n\C-m") win-wid))) + (setq stop-p (or (>= (point) end) + (not (re-search-forward "[\n\C-m]" end t)))) + ) + nb))) + ) + ) +(defun eap-count-symbols-in-string (symbol string) + "SYMBOL - regexp. Return number of SYMBOLs." + (let* ((posix 0) (counter 0) ) + (while (string-match symbol string posix) + (setq posix (match-end 0)) + (setq counter (1+ counter))) + counter)) + +(defvar eap-comment-ends-list + (list (cons 'c++-mode + (list (cons "//" "\n")(cons "[^/\"]/[*]" "[*]/"))) + (cons 'cdl-mode + (list (cons "--" "\n"))) + (cons 'c-mode + (list (cons "/[*]" "[*]/"))) + (cons 'emacs-lisp-mode + (list (cons ";" "\n"))) + (cons 'ccl-mode + (list (cons ";" "\n"))) + (cons 'lisp-mode + (list (cons ";" "\n"))) + (cons 'edl-mode + (list (cons "--" "\n"))) + (cons 'tcl-mode + (list (cons "#" "\n"))) + ) + "*List associating major-mode with list of cons of regexps for comment ends" + ) +(defvar eap-next-comment-ends (cons 0 0) + "Cons of comment end points found by last 'eap-in-comment. +If point is in comment, cdr is 0" + ) +(defun eap-in-comment () + "Check if point is in comment +Return cons cell of comment ends if in comment +Set eap-next-comment-ends" + (let* ((comm-ends-list (cdr (assoc (or major-mode (eap-file-mode)) + eap-comment-ends-list))) + (cur-pnt (point)) + comm-ends in-p beg end) + (save-match-data + (while (and (not in-p) comm-ends-list) + (setq comm-ends (car comm-ends-list)) + (save-excursion + (setq in-p (or (if (looking-at (car comm-ends)) + (setq beg (point)) + ) + (save-excursion + (forward-char -1) + (if (looking-at (car comm-ends)) + (setq beg (point))) + ) + (and (if (re-search-backward (car comm-ends) nil t) + (setq beg (max (or beg 0) (point)))) + (if (re-search-forward (cdr comm-ends) cur-pnt t) + (not (setq end (max (or end 0) (1- (point))))) + t)))) + (or in-p + (setq comm-ends-list (cdr comm-ends-list))) + ))) + (setcar eap-next-comment-ends (or beg 0)) + (setcdr eap-next-comment-ends (or end 0)) + (car comm-ends-list) + ) + ) +(defun eap-quit-comment (&optional backward skip-space-p) + "Move point out of comment +Return non-nil if point was in comment. +If SKIP-SPACE-P, look for closest non-space symbol before comment check" + (let* (in-p comm-ends) + (if skip-space-p + (if backward (skip-chars-backward " \t\n") (skip-chars-forward " \t\n")) + ) + (save-match-data + (while (and (not (if backward (bobp) (eobp))) + (setq comm-ends (or (eap-in-comment) + (and backward (looking-at "$") + (save-excursion + (backward-char 1) + (eap-in-comment))))) + ) + (setq in-p t) + (if backward + (let (at-beg-p) + (goto-char (car eap-next-comment-ends)) + (while (looking-at (car comm-ends)) + ;;(setq at-beg-p t) + (or (/= 0 (skip-chars-backward (car comm-ends))) + (backward-char 1)) + ) +;; (or at-beg-p +;; (re-search-backward (car comm-ends) nil t)) + (and (looking-at "[ \t\n]") + (skip-chars-backward " \t\n") + ;;(skip-chars-backward "^ \t\n") + ) + ) + (if (looking-at "$") + (forward-char 1) + (re-search-forward (cdr comm-ends) nil t)) + (skip-chars-forward "[ \t\n]") + ) + )) + in-p) + ) +(defmacro eap-no-comment (backward-p &rest body) + "Repeatedly execute the BODY while resulting point is in comment. +BODY is executed at least once. +BACKWARD-P means direction to exit from comment" + `(let (eap-no-comment-in) + (while (progn ,@body (and (not (if ,backward-p (bobp) (eobp))) + (eap-quit-comment ,backward-p))) + (setq eap-no-comment-in t)) + eap-no-comment-in) + ) +(defun eap-progress-indicator (cur-val max-val &optional message symbol) + "Send message MESSAGE or `Done: ' with the rest of line dot or SYMBOL filled +according to CUR-VAL to MAX-VAL ratio. SYMBOL must be number." + (let* ((msg (or message "Done: ")) + (len-max (- (frame-width) (length msg) 2)) + (ind-len (round (/ (* cur-val len-max 1.0) max-val))) + (init (or symbol ?.)) + ) + (message "%s %s" msg (make-string ind-len init)) + ) + ) +(defun eap-matching-paren (&optional quiet-p) + "Returns the position of the matchign paren or nil. +QUIET-P means not display errors" + ;;;;;;;; this is a modified copy of show-paren-function() from + ;;;;;;;; paren.el + (let (pos dir mismatch (oldpos (point)) err) + (cond ((eq (char-syntax (preceding-char)) ?\)) + (setq dir -1)) + ((eq (char-syntax (following-char)) ?\() + (setq dir 1))) + (if dir + (save-excursion + (save-restriction + ;; Scan across one sexp within that range. + (condition-case err + (setq pos (scan-sexps (point) dir)) + (error (or quiet-p (message "%s" err)))) + ;; See if the "matching" paren is the right kind of paren + ;; to match the one we started at. + (if pos + (let ((beg (min pos oldpos)) (end (max pos oldpos))) + (and (/= (char-syntax (char-after beg)) ?\$) + (setq mismatch + (not (eq (char-after (1- end)) + ;; This can give nil. + (matching-paren (char-after beg)))))))) + ;; If they don't properly match, use a different face, + ;; or print a message. + (if mismatch + (not (or quiet-p (message "Paren mismatch"))) + pos))))) + ) +(defun on-last-line-p() + (save-excursion + (not (search-forward "\n" nil t))) + ) +(defun eap-first-line-p () + (save-excursion + (not (search-backward "\n" nil t))) + ) +(defun my-next-line (&optional arg) +"Same as 'next-line but not cause error on the last line" + (interactive) + (let ((arg (if arg arg 1))) + (if (on-last-line-p) nil (next-line arg))) + ) +(defun eap-scroll (&optional nbLines down-p) + "Scroll buffer NBLINES up \(or down if DOWN-P is not nil). +If NBLINES is nil, scroll for the window heigth. +To be improved" + (interactive) + (let* ((ws (window-start)) + (we (window-end)) +;;; (win-area (* (window-height) (window-width))) +;;; (max-lines (if down-p +;;; (if (> (- ws win-area) (point-min)) +;;; (buffer-size);; no sence just large number +;;; (count-lines ws (point-min))) +;;; (if (> (point-max) (+ we win-area)) +;;; (buffer-size) +;;; (count-lines we (point-max))))) +;;; (lines (min max-lines (or nbLines (window-height)))) + (lines (or nbLines (window-height))) + (sum (if eap-animation 0 lines)) + (parts '( 1 2 3 4 5 8 11 12 12 11 7 6 5 4 3 2 1)) + step-lines) + (if (not eap-animation) + (scroll-up (if down-p (- lines) lines)) + (condition-case nil + (while (< sum lines) + (setq step-lines + (if parts + (max 1 (round ( / (* lines (car parts)) 100))) + (max 1 (/ (- lines sum) 2)))) + (setq parts (cdr parts)) + ;;(setq step-nb (1+ step-nb)) + (setq sum (+ sum step-lines)) + (scroll-up (if down-p (- step-lines) step-lines)) + (sit-for 0)) + (error nil) + ) + ;; control shot + ;; for long not truncated lines +;;; (and (null nbLines) +;;; (condition-case nil +;;; (while (if down-p +;;; (> (abs (- ws (window-end))) (window-width)) +;;; (> (abs (- we (window-start))) (window-width))) +;;; (scroll-up (if down-p -1 1)) +;;; (sit-for 0) +;;; ) +;;; (error nil))) + ) + sum) + ) + +(defun eap-scroll-down (&optional nbLines) + (interactive) + (eap-scroll nbLines 'down)) + +(defun eap-set-pos-at-line (pos &optional lineNb) + "Scroll buffer until POS is at LINENB of the window. +If LINENB is ommited, act like recenter. Negative LINENB +means LINENB form the window bottom. Return number of +line scrolled." + (let* ((home pos) + (beg (window-start)) + (lineNb (if lineNb + (if (< lineNb 0) + (+ (window-height) lineNb -1) lineNb) + (/ (window-height) 2))) + (homeWay (eap-count-lines home beg)) + (homeWay (if (< beg home) (- homeWay) homeWay)) + (lines (+ lineNb homeWay))) + ;;message "lineNb: %s homeWay: %s lines %s" lineNb homeWay lines) + (if (/= 0 lines) + (condition-case nil + (eap-scroll (abs (1+ lines)) (or (< home beg) (< 0 lines))) + (error nil)) + ) + ;; control shot +;;; (let ((cur-ws (window-start)) +;;; need-ws dir) +;;; (save-excursion +;;; (goto-char pos) +;;; (recenter lineNb) +;;; (setq need-ws (window-start)) +;;; (setq dir (if (< cur-ws need-ws) 1 -1)) +;;; ) +;;; (while (/= cur-ws need-ws) +;;; (scroll-up dir) +;;; (sit-for 0) +;;; (setq cur-ws (window-start)) +;;; )) + ) + ) + +(defvar eap-tmp-buffer-name " eap-tmp-buffer" + ) +(defun eap-tmp-buffer (&optional file-or-buf) + "Return hiden working buffer. +Buffer contents is the one of FILE-OR-BUF \(file-name or buffer). +Buffer contents remains unchanged if FILE-OR-BUF is t. +Buffer is empty in other cases." + (let ((buf (get-buffer eap-tmp-buffer-name))) + (and (null buf) + (set-buffer (setq buf (get-buffer-create eap-tmp-buffer-name))) + (setq buffer-undo-list '(t)) + ) + (if (null file-or-buf) + nil + (set-buffer buf) + (set (make-local-variable 'after-change-functions) nil) + (set (make-local-variable 'after-change-function) nil) + (or (eq t file-or-buf) + (erase-buffer)) + (cond ((buffer-live-p file-or-buf) + (insert (save-excursion + (set-buffer file-or-buf) + (buffer-string))) + ) + ((stringp file-or-buf) + (condition-case nil + (insert-file-contents file-or-buf) + (error nil)) + ) + )) + buf) + ) +(defun eap-erase-buffer (buffer) + "Like erase-buffer but accepts buffer as argument" + (and (buffer-live-p buffer) + (save-excursion + (set-buffer buffer) + (erase-buffer))) + ) +(defun eap-prepare-to-edit () + "Check major mode to set and load. If interactive, rehighlight buffer also. +Run 'eap-prepare-to-edit-hooks" + (interactive) + (sit-for 0) + ;; store as visited + (if buffer-file-name + (eap-add-to-visited-files)) + ;; check major-mode + (let ((mode (eap-file-mode))) + (if (null mode) + nil + (setq major-mode mode) + ;; call major-mode + (if (string= mode-name "Fundamental") + (funcall major-mode)) + ;; hilit + (and (interactive-p) + (member 'hilit19 features) + (hilit-rehighlight-buffer) + ) + ;; check read-only + (if buffer-file-name + (setq buffer-read-only (not (file-writable-p (buffer-file-name))))) + (run-hooks 'eap-prepare-to-edit-hooks) + )) + ) + +(defvar eap-back-file 0 + "Trace path through buffers led to one where this var is local. +Global value is a number of repeated 'eap-come-back-to-origin in one buffer") +(make-variable-buffer-local 'eap-back-file) + +(defun eap-get-back-file () + "Result is for passing to 'eap-save-back-file after jump to other buffer or point" + (cons (cons (or buffer-file-name (buffer-name)) (point)) + (if (local-variable-p 'eap-back-file) + eap-back-file)) + ) +(defun eap-save-back-file (start) + "Keep the way back to file we came from +START is returned by eap-get-back-file" + (setq eap-back-file start) + (let* ((file-point (car start))) + (message (substitute-command-keys + (format "Type '\\[eap-come-back-to-origin]' for returning to `%s'" + (if (string= (car file-point) (or buffer-file-name (buffer-name))) + (cdr file-point) + (file-name-nondirectory (car file-point))) + ))) + ) + ) +(defun eap-come-back-to-origin (kill-start) + "Bring back the file you were before a jump to the visited file. +Prefix argument kills current buffer" + (interactive "P") + (if (not (local-variable-p 'eap-back-file)) + (message "Nowhere to return") + (let* ((chain eap-back-file) + (this-buf (current-buffer)) + (n (if (eq last-command 'eap-come-back-to-origin) + (default-value 'eap-back-file) + (setq-default eap-back-file 0))) + (filePosToReturn (nth n eap-back-file)) + (buf (or (get-buffer (car filePosToReturn)) + (eap-find-file-noselect (car filePosToReturn) 'exist))) + ) + (if (null buf) + (message "Can't return to '%s'" (car filePosToReturn)) + (eap-jump-plus buf kill-start nil this-buf (cdr filePosToReturn)) + (set-buffer buf) + (if (eq this-buf buf) + (setq-default eap-back-file (1+ n)) + (setq eap-back-file (cdr chain))) + ))) + ) +(defun eap-jump-plus (target kill-source back-trace &optional source point line) + "Jump to TARGET and do other things necessary after that. +TARGET is buffer or full file name. +If KILL-SOURCE, SOURCE buffer or current-buffer is killed and TARGET +is shown in current window. Otherwise, pop to TARGET in other window. +Move to POINT. Recenter position the POINT to be on LINE. +BACK-TRACE is returned by eap-get-back-file." + (if target + (let ((src (or source (current-buffer))) + (tgt (if (stringp target) + (eap-find-file-noselect target t) + target)) + ;;(point (or point (point))) + ) + (if (not (eq src tgt)) + (if (not kill-source) + (pop-to-buffer tgt) + (if (buffer-live-p src) (kill-buffer src)) + (switch-to-buffer tgt) + ) + (if back-trace + (goto-char (cdr (car back-trace)))) + (or kill-source + (select-window (display-buffer src 'other-window))) + ) + (and point + eap-animation + line + (sit-for 0) + (eap-set-pos-at-line point line)) + (if point (goto-char point)) + (eap-prepare-to-edit) + (if back-trace (eap-save-back-file back-trace)) + t)) + ) +(defvar eap-visited-files-buf-name "*visited-files*" + "*Buffer name to store names of visited files") + +(defun eap-add-to-visited-files (&optional file) + "Store FILE name in buffer named as 'eap-visited-files-buf-name" + (save-excursion + (let* ((f (or file buffer-file-name)) + (buf (get-buffer eap-visited-files-buf-name)) + add-p) + (and (boundp 'eap-enable-remember-visited) + eap-enable-remember-visited + f + (setq add-p t) + (null buf) + (let* ((dir (concat (eap-home) ".emacs-visited-files")) + (full-name (concat dir "/" + (getenv "USER") "_(" + (eap-replace-all " " "_" (current-time-string)) ")")) + ) + (or (file-exists-p dir) + (condition-case nil + (make-directory dir) + (error (setq full-name nil) )) + ) + (setq buf (set-buffer (get-buffer-create eap-visited-files-buf-name))) + (setq buffer-file-name full-name) + ) + ) + (and add-p + (set-buffer buf) + (goto-char (point-max)) + (if (re-search-backward (format "^%s$" f) nil t) + (progn (eap-kill-line 'no-copy) + (goto-char (point-max))) + t) + (insert f "\n")) + ) + ) + ) + +(add-hook 'find-file-hooks 'eap-add-to-visited-files) + +(defun eap-show-visited-files () + "Show buffer collecting names of visited files. +This feature is controlled by 'eap-enable-remember-visited variable" + (interactive) + (switch-to-buffer (get-buffer-create eap-visited-files-buf-name))) + +(defvar eap-buf-mgt-key-map nil + "Keymap containing bindings to functions for buffer management" + ) +(defun eap-buf-mgt-map () + "Make and return 'eap-buf-mgt-key-map map" + (if (keymapp 'eap-buf-mgt-key-map) + eap-buf-mgt-key-map + (define-prefix-command 'eap-buf-mgt-key-map) + (global-set-key "\C-a" 'eap-buf-mgt-key-map) + eap-buf-mgt-key-map) + ) + +(defun shared-key() +;;; (define-key esc-map [delete] 'eap-kill-line) +;;; (define-key esc-map " " 'eap-prepare-to-edit) + (define-key (eap-buf-mgt-map) "\C-v" 'eap-show-visited-files) + ;;(global-set-key [f4] 'eap-come-back-to-origin) + ) + +(provide 'shared) diff --git a/src/WOKsite/public_el/source-browse.el b/src/WOKsite/public_el/source-browse.el new file mode 100644 index 0000000..026f861 --- /dev/null +++ b/src/WOKsite/public_el/source-browse.el @@ -0,0 +1,497 @@ +;;; source-browse.el --- browse source files contained in CasCade Software Factory + +;;;Author : Edward AGAPOV +;;;History : Thu Oct 11 2001 Creation + +;; Provides commands (with default keybindings): +;; +;; * eap-find-method-declaration C-f3 (global) +;; * eap-find-method-definition S-f3 (global) +;; * eap-find-class-declaration C-f2 (global) +;; * eap-find-class-definition S-f2 (global) +;; * eap-switch-to-inherited-declaration C-f4 +;; * eap-switch-to-inherited-definition S-f4 +;; * eap-switch-def-decl C-f7 +;; * eap-switch-to-lxx S-f7 +;; * eap-open-header S-C-f3 +;; * eap-open-package S-C-f2 + +;; Default keybinding is done by 'source-browse-key function. +;; NOTE: the commands are bound to local map when 'c++-mode-hook and +;; 'cdl-mode-hook run. + +;; All but 'eap-open-header commands called with prefix argument +;; (C-u for ex.) kill current buffer and show search result in +;; current window, otherwise (without argument) display found +;; source file in other window. +;; A way through sources led to current file is kept and you can +;; get back using 'eap-come-back-to-origin command. +;; Names of visited files can be stored in a special buffer. +;; To enable this possibility, set 'eap-enable-remember-visited to t. +;; The buffer can be found calling 'eap-show-visited-files. + +(require 'type-search) +(eval-when-compile ;; a macros needed + (require 'shared) + ) + +(defun eap-same-place-p (buf pnt) + "Check if current buffer is BUF and point is close to PNT" + (and (eq (current-buffer) buf) + (<= (count-lines (point) pnt) 2)) + ) +(defun eap-generic-cdl-instead-of-hxx (header cur-buf cur-pnt) + "Return buffer with either instantiation of HEADER or generic cdl the HEADER instantiates" + (if (not (string-match "[.]hxx" (or header ""))) + nil + (save-excursion + (let* ((instance (file-name-nondirectory header)) + (buf (eap-find-generic instance 'buffer 'existing)) + ) + (and buf + (set-buffer buf) + (eap-same-place-p cur-buf cur-pnt) + (let ((gen-cdl (eap-find-file-with-ext (eap-find-generic instance) "cdl"))) + (if gen-cdl (setq buf (eap-find-file-noselect gen-cdl))) + )) + buf))) + ) +(defun eap-find-method-declaration (&optional kill-start) + "Find declaration of method found at point in c++ file." + (interactive "P") + (eap-find-method-internal kill-start nil) + ) +(defun eap-find-method-definition (&optional kill-start) + "Find definition of method found at point in c++ or cdl file." + (interactive "P") + (eap-find-method-internal kill-start t) + ) +(defun eap-find-method-internal (&optional kill-start definition-p) + "Looks for a cdl, hxx declaration or c++ definition of the method found at point. +Arguments type and number is not taken into account." + (eap-csf-check) + (let* ((start (eap-get-back-file)) + (start-buf (current-buffer)) + (str_pos (eap-method-call-string 'endPos)) + (method_object_class (eap-parse-method-call-string (car str_pos))) + (find-meth '(lambda () + (if buffer-file-name + (eap-find-method-in-current-aux method definition-p start)))) + file_pos file msg + method object class found-p + ) + ;; mark method + (let ((endPos (cdr str_pos))) + (goto-char endPos) (set-mark endPos) (skip-syntax-backward "w_") + ) + (while (and method_object_class (not found-p)) + (setq method (nth 0 method_object_class)) + (setq object (nth 1 method_object_class)) + (setq class (nth 2 method_object_class)) + (setq method_object_class (nthcdr 3 method_object_class)) + (setq msg nil file nil) + (and object + (message "Define type of '%s'..." object) + (setq class (eap-type-of-object object))) + ;; find source file of + (if (null class) + (progn (setq msg (message "Define type of '%s'... Failure" object)) + (sit-for 0.5)) + (if object + (message "Define type of '%s'... Done: '%s'" object class)) + (or (string-match "_" class) + (let ((cls (eap-find-generic-parameter-type class))) + (if cls (setq class cls))) + ) + (setq file (or (eap-find-source class (not definition-p)) + (eap-find-source class definition-p))) + ) + ;; look for method in found source file and ancestor files + (or (if file + (setq file_pos (eap-walk-over-inherited find-meth file nil (not definition-p) t))) + ;; try to find in current (ex. math_FunctionSetRoot, class MyDirFunction) + (member (file-name-nondirectory buffer-file-name) + eap-inherited-walked-over) ;; do not search twice + (string= "Create" method) ;; constructor is in any file + (save-excursion + (and (setq file_pos (funcall find-meth)) + ;; found method must not be class method of current class + (goto-char (nth 1 file_pos)) + (looking-at (format ".*%s[ \t]*::[ \t]*%s" (eap-class-name) method)) + (setq file_pos nil) + )) + (and class (null file) (null msg) + (setq msg (message "No file found for type '%s'" class)) + )) + (setq found-p + (eap-jump-plus (car file_pos) kill-start start start-buf (nth 1 file_pos) 2)) + ) + (if found-p + (skip-syntax-forward "^w") + (and (string= "Create" method) + class + (setq method class)) + (or msg (message "Look for %s()... Not found. Sorry" method)) + ) + ) + ) +(defun eap-find-method-in-current-aux (method definition-p start) + "Look for METHOD in current buffer +Make additional check on buffer type and result returned by eap-find-method-in-current" + (let* ((cur-file buffer-file-name) + (file-name (file-name-nondirectory cur-file)) + (msg (message "Look for %s()... in %s" method file-name)) + (pos (eap-find-method-in-current method)) + generic meth) + (and (null pos) + (string= "Create" method) + (setq meth (eap-class-name file-name)) + (setq pos (eap-find-method-in-current meth)) + ) + (cond + ((null pos) + nil + ) + ;; check if definition found in [cglh]xx + ((and definition-p + (string-match "[.][hcg]xx" cur-file) + (let ((header-p (string-match "[.][h]xx" cur-file)) + stop-check-p) + ;;(skip-chars-backward "^\n") + (while (and (not stop-check-p) + (goto-char pos) + (or + (looking-at "[ \t]*\\(\\(}? *else +\\)?if\\|for\\|switch\\)[ \t\n]*(") + (progn + ;;(search-forward (or meth method)) + (eap-no-comment nil (skip-chars-forward "^{;")) + (not (looking-at "{"))))) + ;; not definition + (if header-p + (setq pos nil stop-check-p t) + ;; suppose declaration or call is found, look for definition + (end-of-line) + (or (setq pos (eap-find-method-in-current method 'from-this-point)) + (setq stop-check-p t)) + )) + stop-check-p)) + ) + ;; check if definition-p found + ((not (eq definition-p (eap-is-definition cur-file))) + (cond + ;; find packed definition if declaration found in BAG instead of definition + ((string-match "/BAG/" cur-file) + (setq pos nil) + (setq generic (eap-find-generic file-name)) + (let* ((def-name (if generic + (concat generic ".gxx") + (concat (eap-class-name cur-file) ".cxx"))) + (bag-path (if generic + (eap-find-file-in-BAG (concat generic ".cdl") "src") + (if (string-match "/src/" cur-file) cur-file nil))) + (buf (if bag-path + (eap-find-packed-file-internal def-name bag-path) + (eap-find-packed-file def-name)))) + (and buf + (set-buffer buf) + (setq pos (eap-find-method-in-current method)) + (setq cur-file buffer-file-name)) + (and (null pos) + (buffer-live-p buf) + (kill-buffer buf)) + (and (null pos) + (setq def-name (eap-make-extention cur-file "lxx")) + (setq buf (eap-find-packed-file-internal def-name cur-file)) + (set-buffer buf) + (setq pos (eap-find-method-in-current method)) + (setq cur-file buffer-file-name)) + (and (null pos) + (buffer-live-p buf) + (kill-buffer buf)) + ) + ) + ) + ) + ;; find cdl of generic instead of hxx of instance + ((and (not definition-p) + (string-match "[.]hxx" cur-file) + (setq generic (eap-find-generic file-name))) + (let* ((gen-file (eap-find-file-with-ext generic "cdl")) + (buf (if gen-file (set-buffer (eap-find-file-noselect gen-file)))) + (gen-pos (if gen-file (eap-find-method-in-current method))) + ) + (if (null gen-pos) + (if buf (kill-buffer buf)) + (setq pos gen-pos) + (setq cur-file gen-file))) + ) + ) ;; cond + (goto-char (cdr (car start))) + (if pos + ;; check if we returned back + (if (and (string= (car (car start)) cur-file) + (<= (count-lines (cdr (car start)) pos) 2)) + (setq pos nil) + (list cur-file pos))) + ) + ) +(defun eap-find-class-declaration (&optional kill-start) + "Find declaration of class found at point in any buffer. +If a c++ object is at point, find it's class declaration." + (interactive "P") + (eap-find-class kill-start t)) +(defun eap-find-class-definition (&optional kill-start) + "Find definition of class found at point in any buffer. +If a c++ object is at point, find it's class definition." + (interactive "P") + (eap-find-class kill-start nil)) +(defun eap-find-class (&optional kill-start decl-p) + "Find file declaring or implementing a class found near point +in C++/CDL buffer." + (eap-csf-check) + (let* ((start (eap-get-back-file)) + (cur-buf (current-buffer)) + (cur-pnt (point)) + (cls (or (eap-class-in-cdl) + (eap-current-word))) + file buffer pnt line) + (message "Look for class %s..." (if decl-p "declaration" "definition")) + (or (string-match "_" cls) + ;; find package file + (setq file (eap-find-source cls decl-p)) + ;; add package name before + (setq cls (eap-find-pack-for-class cls)) + ;; find object type in cxx + (setq cls (eap-current-type)) + ) + (or file + (null cls) + (setq file (eap-find-source cls decl-p)) + (if (not decl-p) + (setq buffer (eap-find-packed-file cls))) + ;; find generic + (let (gen) + (if decl-p + (and (setq buffer (eap-find-generic cls 'buf 'existing)) + (set-buffer buffer) + (setq pnt (point)) + (eap-same-place-p cur-buf cur-pnt) + (if (= (buffer-modified-tick buffer) 1) + (kill-buffer buffer) t) ;; kill if newly opened + (setq pnt nil + gen (eap-find-generic cls)) + (setq file (eap-find-file-with-ext gen "cdl"))) + (and (setq gen (eap-find-generic cls)) + (setq file (eap-find-source gen decl-p)))) + (or file buffer) + ) + ;; find enum + (setq buffer (eap-find-enum cls 'buf 'exist)) + ;; find class declared in current cxx + (and (set-buffer cur-buf) + (string-match "[.][cg]xx" buffer-file-name) + (setq pnt (save-excursion + (re-search-backward + (format "^[ \t]*class[ \t\n]+%s[ \t\n]*[:{]" cls) nil t))) + (setq buffer cur-buf line 2)) + ) + ;; instantiation in cdl instead of instance header + (and file + decl-p + (setq buffer (eap-generic-cdl-instead-of-hxx file cur-buf cur-pnt)) + (set-buffer buffer) + (setq pnt (point)) + ) + (if (eap-jump-plus (or buffer file) kill-start start cur-buf pnt line) + (message "Ok") + (message "not found: %s.*" cls)) + ) + ) +(defvar eap-complete-find-file-history nil + ) +(defun eap-complete-find-file (update-types-list) + "Find file with extention providing file name completion. +Prefix arguments forces updating list of existing files." + (interactive "P") + (let (( init (if mark-active (buffer-substring (point) (mark)) "")) + file path ext predicate require-match) + (if (> (length init) 30) + (setq init "")) + (eap-check-all-type-list update-types-list) + (while (null ext) + (setq file (completing-read "File: " + eap-all-type-list + predicate require-match init + 'eap-complete-find-file-history)) + (setq ext (eap-extention file)) + (if ext + (setq file (file-name-nondirectory file)) + (message "Provide file extention") + (sit-for 0.5) + (setq init file)) + ) + (setq path (eap-find-file-with-ext file ext)) + (if (null path) + (message "%s.%s not found" file ext) + (eap-find-file path 'existing) + (eap-prepare-to-edit) + (message "Ok" )) + ) + ) +(defun eap-switch-to-inherited-declaration (&optional kill-start) + "Switch to declaration of inherited class of current one." + (interactive "P") + (eap-switch-to-inherited kill-start t) + ) +(defun eap-switch-to-inherited-definition (&optional kill-start) + "Switch to definition of inherited class of current one." + (interactive "P") + (eap-switch-to-inherited kill-start nil) + ) +(defun eap-switch-to-inherited (&optional kill-start decl-p) + "switch to inherited or generic class" + (eap-csf-check) + (let* ((start (eap-get-back-file)) + (start-name (file-name-nondirectory (buffer-file-name))) + (pearent (or (eap-pearent) + (eap-find-generic start-name))) + buf found-file + ) + (if (null pearent) + (message "No pearent found for %s" start-name) + (or (setq found-file (eap-find-source pearent decl-p)) + decl-p + (setq buf (eap-find-packed-file pearent)) + ) + (and found-file + decl-p + (setq buf (eap-generic-cdl-instead-of-hxx found-file nil 0)) + ) + (or (eap-jump-plus (or buf found-file) kill-start start) + (message "%s not found" pearent)) + ) + ) + ) + +(defun eap-switch-to-lxx (kill-start) + "Switch from current file to lxx file and from lxx to [cg]xx file." + (interactive "P") + (eap-switch-def-decl kill-start 'lxx) + ) +(defun eap-switch-def-decl (kill-start &optional to-lxx) + "Switch between definition and declaration of current class." + (interactive "P") + (eap-csf-check) + (if (null buffer-file-name) + (error "Wrong file type") + (and to-lxx + (string-match "[.]lxx" buffer-file-name) + (setq to-lxx nil)) + (let* ((start (eap-get-back-file)) + (fileName (eap-class-name)) + (decl-p nil) + (file (if to-lxx + (eap-find-file-with-ext fileName "lxx") + (setq decl-p (string-match "[.][gc]xx" (or buffer-file-name (buffer-name)))) + (eap-find-source fileName decl-p))) + buf) + (or file + ;; if file name differs from class name + (let ((class (eap-class-name-by-method-def fileName))) + (if class + (if to-lxx + (eap-find-file-with-ext class "lxx") + (setq decl-p (string-match "[.][gc]xx" class)) + (eap-find-source class decl-p))) + ) + decl-p + (setq buf (eap-find-packed-file fileName (if to-lxx "lxx")))) + ;; prefer generic cdl instead of instance hxx + (and file + decl-p + (setq buf (eap-generic-cdl-instead-of-hxx file nil 0))) + (setq fileName (eap-class-name fileName)) + (or (eap-jump-plus (or buf file) kill-start start) + (cond + (to-lxx + (not (message "'%s.lxx' not found" fileName)) + ) + (decl-p + (not (message "Neither '%s.cdl' nor '%s.hxx' is found" fileName fileName)) + ) + (t + (not (message "Neither '%s.cxx' nor '%s.gxx' is found" fileName fileName)) + )) + ))) + ) + +(defun eap-open-header (ofCurrentFile) + "Show header file for current buffer class (with prefix argument) or class at point." + (interactive "P") + (eap-csf-check) + (let* ((start (eap-get-back-file)) + (type (if ofCurrentFile buffer-file-name (eap-current-type))) + (type-name (if type (eap-class-name type))) + (msg (message "Look for %s.hxx..." type-name)) + (foxName (if type (eap-find-file-with-ext type "hxx"))) + ) + (or (eap-jump-plus foxName nil start) + (if type + (message "%s Not found" msg) + (if ofCurrentFile + (message "Open header: Wrong buffer type") + (message "Open header: no type found at point")) + )) + ) + ) +(defun eap-open-package (&optional kill-start) + "Show file of package the current buffer class belongs to. +First look for cdl then, if failed, for definition" + (interactive "P") + (if (null buffer-file-name) + (not (message "Wrong buffer type")) + (let* ((start (eap-get-back-file)) + (package (eap-get-package-name buffer-file-name)) + (file (concat (eap-n-level-up buffer-file-name) package ".cdl")) + ) + (or (file-exists-p file) + (setq file (eap-find-file-with-ext package "cdl")) + (setq file (eap-find-source package nil)) + ) + (if (eap-jump-plus file kill-start start) + (message "Ok") + (not (message "%s.cdl not found" package))) + )) + ) +(defun source-browse-local-key () + (define-key (current-local-map) [C-f4] 'eap-switch-to-inherited-declaration) + (define-key (current-local-map) [S-f4] 'eap-switch-to-inherited-definition) + (define-key (current-local-map) [C-f7] 'eap-switch-def-decl) + (define-key (current-local-map) [S-f7] 'eap-switch-to-lxx) + (define-key (current-local-map) [S-C-f2] 'eap-open-package) + (define-key (current-local-map) [S-C-f3] 'eap-open-header) + + ;; repeat - override local bindings + (define-key (current-local-map) [C-f2] 'eap-find-class-declaration) + (define-key (current-local-map) [S-f2] 'eap-find-class-definition) + (define-key (current-local-map) [C-f3] 'eap-find-method-declaration) + (define-key (current-local-map) [S-f3] 'eap-find-method-definition) + + (define-key (current-local-map) [M-f4] 'eap-come-back-to-origin) + ) +(defun source-browse-key () + (global-set-key [C-f2] 'eap-find-class-declaration) + (global-set-key [S-f2] 'eap-find-class-definition) + (global-set-key [C-f3] 'eap-find-method-declaration) + (global-set-key [S-f3] 'eap-find-method-definition) + + (global-set-key [C-S-f4] 'eap-complete-find-file) + + (define-key esc-map " " 'eap-prepare-to-edit) + + (add-hook 'cdl-mode-hook 'source-browse-local-key 'append) + (add-hook 'c++-mode-hook 'source-browse-local-key 'append) + ) + + +(provide 'source-browse) diff --git a/src/WOKsite/public_el/tcl-mode.el b/src/WOKsite/public_el/tcl-mode.el new file mode 100644 index 0000000..0c13c14 --- /dev/null +++ b/src/WOKsite/public_el/tcl-mode.el @@ -0,0 +1,2045 @@ +;; tcl.el --- Tcl code editing commands for Emacs + +;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Maintainer: Tom Tromey +;; Author: Tom Tromey +;; Chris Lindblad +;; Keywords: languages tcl modes +;; Version: $Revision: 1.3 $ + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 1, or (at your option) +;; any later version. + +;; GNU Emacs 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 for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;; HOW TO INSTALL: +;; Put the following forms in your .emacs to enable autoloading of Tcl +;; mode, and auto-recognition of ".tcl" files. +;; +;; (autoload 'tcl-mode "tcl" "Tcl mode." t) +;; (autoload 'inferior-tcl "tcl" "Run inferior Tcl process." t) +;; (setq auto-mode-alist (append '(("\\.tcl$" . tcl-mode)) auto-mode-alist)) +;; +;; If you plan to use the interface to the TclX help files, you must +;; set the variable tcl-help-directory to point to the topmost +;; directory containing the TclX help files. Eg: +;; +;; (setq tcl-help-directory "/usr/local/lib/tclx/help") +;; +;; Also you will want to add the following to your .emacs: +;; +;; (autoload 'tcl-help-on-word "tcl" "Help on Tcl commands" t) +;; +;; FYI a *very* useful thing to do is nroff all the Tk man pages and +;; put them in a subdir of the help system. +;; + +;;; Commentary: + +;; LCD Archive Entry: +;; tcl|Tom Tromey|tromey@busco.lanl.gov| +;; Major mode for editing Tcl| +;; 6-Apr-94|$Revision: 1.3 $| + +;; CUSTOMIZATION NOTES: +;; * tcl-proc-list can be used to customize a list of things that +;; "define" other things. Eg in my project I put "defvar" in this +;; list. +;; * tcl-typeword-list is similar, but uses font-lock-type-face. +;; * tcl-keyword-list is a list of keywords. I've generally used this +;; for flow-control words. Eg I add "unwind_protect" to this list. +;; * tcl-type-alist can be used to minimally customize indentation +;; according to context. + +;; Change log: +;; 18-Mar-1994 Tom Tromey Fourth beta release. +;; Added {un,}comment-region to menu. Idea from +;; Mike Scheidler +;; 17-Mar-1994 Tom Tromey +;; Fixed tcl-restart-with-file. Bug fix attempt in +;; tcl-internal-end-of-defun. +;; 16-Mar-1994 Tom Tromey Third beta release +;; Added support code for menu (from Tcl mode written by +;; schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid)). +;; 12-Mar-1994 Tom Tromey +;; Better documentation for inferior-tcl-buffer. Wrote +;; tcl-restart-with-file. Wrote Lucid Emacs menu (but no +;; code to install it). +;; 12-Mar-1994 Tom Tromey +;; Wrote tcl-guess-application. Another stab at making +;; tcl-omit-ws-regexp work. +;; 10-Mar-1994 Tom Tromey Second beta release +;; Last Modified: Thu Mar 10 01:24:25 1994 (Tom Tromey) +;; Wrote perl-mode style line indentation command. +;; Wrote more documentation. Added tcl-continued-indent-level. +;; Integrated help code. +;; 8-Mar-1994 Tom Tromey +;; Last Modified: Tue Mar 8 11:58:44 1994 (Tom Tromey) +;; Bug fixes. +;; 6-Mar-1994 Tom Tromey +;; Last Modified: Sun Mar 6 18:55:41 1994 (Tom Tromey) +;; Updated auto-newline support. +;; 6-Mar-1994 Tom Tromey Beta release +;; Last Modified: Sat Mar 5 17:24:32 1994 (Tom Tromey) +;; Wrote tcl-hashify-buffer. Other minor bug fixes. +;; 5-Mar-1994 Tom Tromey +;; Last Modified: Sat Mar 5 16:11:20 1994 (Tom Tromey) +;; Wrote electric-hash code. +;; 3-Mar-1994 Tom Tromey +;; Last Modified: Thu Mar 3 02:53:40 1994 (Tom Tromey) +;; Added code to handle auto-fill in comments. +;; Added imenu support code. +;; Cleaned up code. +;; Better font-lock support. +;; 28-Feb-1994 Tom Tromey +;; Last Modified: Mon Feb 28 14:08:05 1994 (Tom Tromey) +;; Made tcl-figure-type more easily configurable. +;; 28-Feb-1994 Tom Tromey +;; Last Modified: Mon Feb 28 01:02:58 1994 (Tom Tromey) +;; Wrote inferior-tcl mode. +;; 16-Feb-1994 Tom Tromey +;; Last Modified: Wed Feb 16 17:05:19 1994 (Tom Tromey) +;; Added support for font-lock-mode. +;; 29-Oct-1993 Tom Tromey +;; Last Modified: Sun Oct 24 17:39:14 1993 (Tom Tromey) +;; Patches from Guido Bosch to make things work with Lucid Emacs. +;; 22-Oct-1993 Tom Tromey +;; Last Modified: Fri Oct 22 15:26:46 1993 (Tom Tromey) +;; Made many characters have "_" syntax class; suggested by Guido +;; Bosch . Note that this includes the "$" +;; character, which might be a change you'd notice. +;; 21-Oct-1993 Tom Tromey +;; Last Modified: Thu Oct 21 20:28:40 1993 (Tom Tromey) +;; More fixes for tcl-omit-ws-regexp. +;; 20-Oct-1993 Tom Tromey +;; Started keeping history. Fixed tcl-{beginning,end}-of-defun. +;; Added some code to make things work with Emacs 18. + +;; THANKS TO: +;; Guido Bosch +;; pgs1002@esc.cam.ac.uk (Dr P.G. Sjoerdsma) +;; Mike Scheidler +;; Matt Newman +;; rwhitby@research.canon.oz.au (Rod Whitby) +;; h9118101@hkuxa.hku.hk (Yip Chi Lap [Beta]) +;; Pertti Tapio Kasanen +;; schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid) + +;; KNOWN BUGS: +;; * indent-region should skip blank lines. (It does in v19, so I'm +;; not motivated to fix it here). +;; * In Tcl "#" is not always a comment character. This can confuse +;; tcl.el in certain circumstances. For now the only workaround is +;; to enclose offending hash characters in quotes or precede it with +;; a backslash. Note that using braces won't work -- quotes change +;; the syntax class of characters between them, while braces do not. +;; The electric-# mode helps alleviate this problem somewhat. +;; * indent-tcl-exp is untested. +;; * Doesn't work under Emacs 18 yet. +;; * There's been a report that font-lock does strange things under +;; Lucid Emacs 19.6. For instance in "proc foobar", the space +;; before "foobar" is highlighted. + +;; TODO: +;; * make add-log-tcl-defun smarter. should notice if we are in the +;; middle of a defun, or between defuns. should notice if point is +;; on first line of defun (or maybe even in comments before defun). +;; * Allow continuation lines to be indented under the first argument +;; of the preceeding line, like this: +;; [list something \ +;; something-else] +;; * There is a request that indentation work like this: +;; button .fred -label Fred \ +;; -command {puts fred} +;; * Should have tcl-complete-symbol that queries the inferior process. +;; * Should have describe-symbol that works by sending the magic +;; command to a tclX process. +;; * Need C-x C-e binding (tcl-eval-last-exp). +;; * Write indent-region function that is faster than indenting each +;; line individually. +;; * tcl-figure-type should stop at "beginning of line" (only ws +;; before point, and no "\" on previous line). (see tcl-real-command-p). +;; * Fix beginning-of-defun. I believe this will be fully possible in +;; FSF Emacs 19.23 +;; * overrides some comint keybindings; fix. +;; * Trailing \ will eat blank lines. Should deal with this. +;; (this would help catch some potential bugs). +;; * Inferior should display in half the screen, not the whole screen. + + + + + + + + + + + + + + + + + + + + + + + + +;;; Code: + +(require 'comint) + +;; +;; User variables. +;; + +(defvar tcl-indent-level 4 + "*Indentation of Tcl statements with respect to containing block.") + +(defvar tcl-continued-indent-level 4 + "*Indentation of continuation line relative to first line of command.") + +(defvar tcl-auto-newline nil + "*Non-nil means automatically newline before and after braces +inserted in Tcl code.") + +(defvar tcl-tab-always-indent t + "*Control effect of TAB key. +If t (the default), always indent current line. +If nil and point is not in the indentation area at the beginning of +the line, a TAB is inserted. +Other values cause the first possible action from the following list +to take place: + + 1. Move from beginning of line to correct indentation. + 2. Delete an empty comment. + 3. Move forward to start of comment, indenting if necessary. + 4. Move forward to end of line, indenting if necessary. + 5. Create an empty comment. + 6. Move backward to start of comment, indenting if necessary.") + +(defvar tcl-use-hairy-comment-detector t + "*If not `nil', the the more complicated, but slower, comment +detecting function is used. This variable is only used in GNU Emacs +19 (the fast function is always used elsewhere).") + +(defvar tcl-electric-hash-style 'smart + "*Style of electric hash insertion to use. +Possible values are 'backslash, meaning that `\\' quoting should be +done; `quote, meaning that `\"' quoting should be done; 'smart, +meaning that the choice between 'backslash and 'quote should be +made depending on the number of hashes inserted; or nil, meaning that +no quoting should be done. Any other value for this variable is +taken to mean 'smart. The default is 'smart.") + +(defvar tcl-help-directory nil + "*Name of topmost directory containing TclX help files") + +(defvar tcl-use-smart-word-finder t + "*If not nil, use a better way of finding the current word when +looking up help on a Tcl command.") + +(defvar tcl-application "wish" + "*Name of Tcl application to run in inferior Tcl mode.") + +(defvar tcl-command-switches nil + "*Switches to supply to `tcl-application'.") + +(defvar tcl-prompt-regexp "^\\(% \\|\\)" + "*If not nil, a regexp that will match the prompt in the inferior process. +If nil, the prompt is the name of the application with \">\" appended. + +The default is \"^\\(% \\|\\)\", which will match the default primary +and secondary prompts for tclsh and wish.") + +(defvar inferior-tcl-source-command "source %s\n" + "*Format-string for building a Tcl command to load a file. +This format string should use `%s' to substitute a file name +and should result in a Tcl expression that will command the +inferior Tcl to load that file. The filename will be appropriately +quoted for Tcl.") + +;; +;; Keymaps, abbrevs, syntax tables. +;; + +(defvar tcl-mode-abbrev-table nil + "Abbrev table in use in Tcl-mode buffers.") +(if tcl-mode-abbrev-table + () + (define-abbrev-table 'tcl-mode-abbrev-table ())) + +;; I sure wish Emacs had a package that made it easy to extract this +;; sort of information. +(defconst tcl-using-emacs-19 (string-match "19\\." emacs-version) + "Nil unless using Emacs 19 (Lucid or FSF).") + +;; FIXME this will break on Emacs 19.100. +(defconst tcl-using-emacs-19.23 + (string-match "19\\.\\(2[3-9]\\|[3-9][0-9]\\)" emacs-version) + "Nil unless using Emacs 19.23 or later.") + +(defconst tcl-using-lemacs-19 (string-match "Lucid" emacs-version) + "Nil unless using Lucid Emacs).") + +(defvar tcl-mode-map () + "Keymap used in Tcl mode.") +(if tcl-mode-map + () + (setq tcl-mode-map (make-sparse-keymap)) + (define-key tcl-mode-map "{" 'tcl-electric-char) + (define-key tcl-mode-map "}" 'tcl-electric-brace) + (define-key tcl-mode-map "[" 'tcl-electric-char) + (define-key tcl-mode-map "]" 'tcl-electric-char) + (define-key tcl-mode-map ";" 'tcl-electric-char) + (define-key tcl-mode-map "#" 'tcl-electric-hash) + ;; FIXME. + (define-key tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun) + ;; FIXME. + (define-key tcl-mode-map "\e\C-e" 'tcl-end-of-defun) + ;; FIXME. + (define-key tcl-mode-map "\e\C-h" 'mark-tcl-function) + (define-key tcl-mode-map "\e\C-q" 'indent-tcl-exp) + (define-key tcl-mode-map "\177" 'backward-delete-char-untabify) + (define-key tcl-mode-map "\t" 'tcl-indent-command) + (define-key tcl-mode-map "\M-\C-x" 'tcl-eval-defun) + (and (fboundp 'comment-region) + (define-key tcl-mode-map "\C-c\C-c" 'comment-region)) + (define-key tcl-mode-map "\C-c\C-d" 'tcl-help-on-word) + (define-key tcl-mode-map "\C-c\C-e" 'tcl-eval-defun) + (define-key tcl-mode-map "\C-c\C-l" 'tcl-load-file) + (define-key tcl-mode-map "\C-c\C-p" 'inferior-tcl) + (define-key tcl-mode-map "\C-c\C-r" 'tcl-eval-region) + (define-key tcl-mode-map "\C-c\C-z" 'switch-to-tcl)) + +(defvar tcl-mode-syntax-table nil + "Syntax table in use in Tcl-mode buffers.") +(if tcl-mode-syntax-table + () + (setq tcl-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?% "_" tcl-mode-syntax-table) + (modify-syntax-entry ?@ "_" tcl-mode-syntax-table) + (modify-syntax-entry ?& "_" tcl-mode-syntax-table) + (modify-syntax-entry ?* "_" tcl-mode-syntax-table) + (modify-syntax-entry ?+ "_" tcl-mode-syntax-table) + (modify-syntax-entry ?- "_" tcl-mode-syntax-table) + (modify-syntax-entry ?. "_" tcl-mode-syntax-table) + (modify-syntax-entry ?: "_" tcl-mode-syntax-table) + (modify-syntax-entry ?! "_" tcl-mode-syntax-table) + (modify-syntax-entry ?$ "_" tcl-mode-syntax-table) ; FIXME use "'"? + (modify-syntax-entry ?/ "_" tcl-mode-syntax-table) + (modify-syntax-entry ?~ "_" tcl-mode-syntax-table) + (modify-syntax-entry ?< "_" tcl-mode-syntax-table) + (modify-syntax-entry ?= "_" tcl-mode-syntax-table) + (modify-syntax-entry ?> "_" tcl-mode-syntax-table) + (modify-syntax-entry ?| "_" tcl-mode-syntax-table) + (modify-syntax-entry ?\( "()" tcl-mode-syntax-table) + (modify-syntax-entry ?\) ")(" tcl-mode-syntax-table) + (modify-syntax-entry ?\; "." tcl-mode-syntax-table) + (modify-syntax-entry ?\n "> " tcl-mode-syntax-table) + (modify-syntax-entry ?\f "> " tcl-mode-syntax-table) + (modify-syntax-entry ?# "< " tcl-mode-syntax-table)) + +(defvar inferior-tcl-mode-map nil + "Keymap used in Inferior Tcl mode.") +(if inferior-tcl-mode-map + () + ;; FIXME Use keymap inheritance here? FIXME we override comint + ;; keybindings here. Maybe someone has a better set? + (setq inferior-tcl-mode-map (copy-keymap comint-mode-map)) + (define-key inferior-tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun) + (define-key inferior-tcl-mode-map "\e\C-e" 'tcl-end-of-defun) + (define-key inferior-tcl-mode-map "\177" 'backward-delete-char-untabify) + (define-key inferior-tcl-mode-map "\M-\C-x" 'tcl-eval-defun) + (define-key inferior-tcl-mode-map "\C-c\C-d" 'tcl-help-on-word) + (define-key inferior-tcl-mode-map "\C-c\C-e" 'tcl-eval-defun) + (define-key inferior-tcl-mode-map "\C-c\C-l" 'tcl-load-file) + (define-key inferior-tcl-mode-map "\C-c\C-p" 'inferior-tcl) + (define-key inferior-tcl-mode-map "\C-c\C-r" 'tcl-eval-region) + (define-key inferior-tcl-mode-map "\C-c\C-z" 'switch-to-tcl)) + +;; Lucid Emacs menu. +(defvar tcl-lucid-menu + '("Tcl" + ["Beginning of function" tcl-beginning-of-defun t] + ["End of function" tcl-end-of-defun t] + ["Mark function" mark-tcl-function t] + ["Indent region" indent-region t] + ["Comment region" comment-region t] + ["Uncomment region" tcl-uncomment-region t] + "----" + ["Show Tcl process buffer" inferior-tcl t] + ["Send function to Tcl process" tcl-eval-defun t] + ["Send region to Tcl process" tcl-eval-region t] + ["Send file to Tcl process" tcl-load-file t] + ["Restart Tcl process with file" tcl-restart-with-file t] + "----" + ["Tcl help" tcl-help-on-word t])) + +(defvar inferior-tcl-buffer nil + "*The current inferior-tcl process buffer. + +MULTIPLE PROCESS SUPPORT +=========================================================================== +To run multiple Tcl processes, you start the first up with +\\[inferior-tcl]. It will be in a buffer named `*inferior-tcl*'. +Rename this buffer with \\[rename-buffer]. You may now start up a new +process with another \\[inferior-tcl]. It will be in a new buffer, +named `*inferior-tcl*'. You can switch between the different process +buffers with \\[switch-to-buffer]. + +Commands that send text from source buffers to Tcl processes -- like +`tcl-eval-defun' or `tcl-load-file' -- have to choose a process to +send to, when you have more than one Tcl process around. This is +determined by the global variable `inferior-tcl-buffer'. Suppose you +have three inferior Lisps running: + Buffer Process + foo inferior-tcl + bar inferior-tcl<2> + *inferior-tcl* inferior-tcl<3> +If you do a \\[tcl-eval-defun] command on some Lisp source code, what +process do you send it to? + +- If you're in a process buffer (foo, bar, or *inferior-tcl*), + you send it to that process. +- If you're in some other buffer (e.g., a source file), you + send it to the process attached to buffer `inferior-tcl-buffer'. +This process selection is performed by function `inferior-tcl-proc'. + +Whenever \\[inferior-tcl] fires up a new process, it resets +`inferior-tcl-buffer' to be the new process's buffer. If you only run +one process, this does the right thing. If you run multiple +processes, you can change `inferior-tcl-buffer' to another process +buffer with \\[set-variable].") + +;; +;; Hooks and other customization. +;; + +(defvar tcl-mode-hook nil + "Hook run on entry to Tcl mode. + +Several functions exist which are useful to run from your +`tcl-mode-hook' (see each function's documentation for more +information): + + tcl-install-menubar + Puts a \"Tcl\" menu on the menubar. Doesn't work in Emacs 18. + tcl-guess-application + Guesses a default setting for `tcl-application' based on any + \"#!\" line at the top of the file. + tcl-hashify-buffer + Quotes all \"#\" characters that don't correspond to actual + Tcl comments. (Useful when editing code not originally created + with this mode). + tcl-auto-fill-mode + Auto-filling of Tcl comments. + +Emacs 19 users can add functions to the hook with `add-hook': + + (add-hook 'tcl-mode-hook 'tcl-guess-application) + +Emacs 18 users must use `setq': + + (setq tcl-mode-hook (cons 'tcl-guess-application tcl-mode-hook))") + + +(defvar inferior-tcl-mode-hook nil + "Hook for customizing Inferior Tcl mode.") + +(defvar tcl-proc-list + '("proc") + "List of commands whose first argument defines something. +This exists because some people (eg, me) use \"defvar\" et al. +Call `tcl-set-proc-regexp' and `tcl-set-font-lock-keywords' +after changing this list.") + +(defvar tcl-proc-regexp nil + "Regexp to use when matching proc headers.") + +(defvar tcl-typeword-list + '("global" "upvar") + "List of Tcl keywords deonting \"type\". Used only for highlighting. +Call `tcl-set-font-lock-keywords' after changing this list.") + +;; Generally I've picked control operators to be keywords. +(defvar tcl-keyword-list + '("if" "then" "else" "elseif" "for" "foreach" "break" "continue" "while" + "eval" "case" "in" "switch" "default" "exit" "error" "proc" "return" + "uplevel" "loop" "for_array_keys" "for_recursive_glob" "for_file") + "List of Tcl keywords. Used only for highlighting. +Default list includes some TclX keywords. +Call `tcl-set-font-lock-keywords' after changing this list.") + +(defvar tcl-font-lock-keywords nil + "Keywords to highlight for Tcl. See variable `font-lock-keywords'. +This variable is generally set from `tcl-proc-regexp', +`tcl-typeword-list', and `tcl-keyword-list' by the function +`tcl-set-font-lock-keywords'.") + +;; FIXME need some way to recognize variables because array refs look +;; like 2 sexps. +(defvar tcl-type-alist + '( + ("expr" tcl-expr) + ("catch" tcl-commands) + ("if" tcl-expr "then" tcl-commands) + ("elseif" tcl-expr "then" tcl-commands) + ("elseif" tcl-expr tcl-commands) + ("if" tcl-expr tcl-commands) + ("while" tcl-expr tcl-commands) + ("for" tcl-commands tcl-expr tcl-commands tcl-commands) + ("foreach" nil nil tcl-commands) + ("for_file" nil nil tcl-commands) + ("for_array_keys" nil nil tcl-commands) + ("for_recursive_glob" nil nil nil tcl-commands) + ;; Loop handling is not perfect, because the third argument can be + ;; either a command or an expr, and there is no real way to look + ;; forward. + ("loop" nil tcl-expr tcl-expr tcl-commands) + ("loop" nil tcl-expr tcl-commands) + ) + "Alist that controls indentation. +\(Actually, this really only controls what happens on continuation lines). +Each entry looks like `(KEYWORD TYPE ...)'. +Each type entry describes a sexp after the keyword, and can be one of: +* nil, meaning that this sexp has no particular type. +* tcl-expr, meaning that this sexp is an arithmetic expression. +* tcl-commands, meaning that this sexp holds Tcl commands. +* a string, which must exactly match the string at the corresponding + position for a match to be made. + +For example, the entry for the \"loop\" command is: + + (\"loop\" nil tcl-expr tcl-commands) + +This means that the \"loop\" command has three arguments. The first +argument is ignored (for indentation purposes). The second argument +is a Tcl expression, and the last argument is Tcl commands.") + +(defvar tcl-explain-indentation nil + "If not `nil', debugging message will be printed during indentation.") + + + + + + + + + + + + + + + + + + + + + + + + + + +;; +;; Work around differences between various versions of Emacs. +;; + +;; We use this because Lemacs 19.9 has what we need. +(defconst tcl-pps-has-arg-6 + (or tcl-using-emacs-19 + (and tcl-using-lemacs-19 + (condition-case nil + (progn + (parse-partial-sexp (point) (point) nil nil nil t) + t) + (error nil)))) + "t if using an emacs which supports sixth (\"commentstop\") argument +to parse-partial-sexp.") + +;; Its pretty bogus to have to do this, but there is no easier way to +;; say "match not syntax-1 and not syntax-2". Too bad you can't put +;; \s in [...]. This sickness is used in Emacs 19 to match a defun +;; starter. (It is used for this in v18 as well). +;;(defconst tcl-omit-ws-regexp +;; (concat "^\\(\\s" +;; (mapconcat 'char-to-string "w_.()\"\\$'/" "\\|\\s") +;; "\\)\\S(*") +;; "Regular expression that matches everything except space, comment +;;starter, and comment ender syntax codes.") + +;; FIXME? Instead of using the hairy regexp above, we just use a +;; simple one. +;;(defconst tcl-omit-ws-regexp "^[^] \t\n#}]\\S(*" +;; "Regular expression used in locating function definitions.") + +;; Here's another stab. I think this one actually works. Now the +;; problem seems to be that there is a bug in Emacs 19.22 where +;; end-of-defun doesn't really use the brace matching the one that +;; trails defun-prompt-regexp. +(defconst tcl-omit-ws-regexp "^[^ \t\n#}][^\n}]+}*[ \t]+") + +(defun tcl-internal-beginning-of-defun (&optional arg) + "Move backward to next beginning-of-defun. +With argument, do this that many times. +Returns t unless search stops due to end of buffer." + (interactive "p") + (if (or (null arg) (= arg 0)) + (setq arg 1)) + (let (success) + (while (progn + (setq arg (1- arg)) + (and (>= arg 0) + (setq success + (re-search-backward tcl-omit-ws-regexp nil 'move 1)))) + (while (and (looking-at "[]#}]") + (setq success + (re-search-backward tcl-omit-ws-regexp nil 'move 1))))) + (beginning-of-line) + (not (null success)))) + +(defun tcl-internal-end-of-defun (&optional arg) + "Move forward to next end of defun. +An end of a defun is found by moving forward from the beginning of one." + (interactive "p") + (if (or (null arg) (= arg 0)) (setq arg 1)) + (let ((start (point))) + ;; Was forward-char. I think this works a little better. + (forward-line) + (tcl-beginning-of-defun) + (while (> arg 0) + (while (and (re-search-forward tcl-omit-ws-regexp nil 'move 1) + (progn (beginning-of-line) t) + (looking-at "[]#}]") + (progn (forward-line) t))) + (let ((next-line (save-excursion + (forward-line) + (point)))) + (while (< (point) next-line) + (forward-sexp))) + (forward-line) + (if (> (point) start) (setq arg (1- arg)))))) + +;; In Emacs 19, we can use begining-of-defun as long as we set up a +;; certain regexp. In Emacs 18, we need our own function. +(fset 'tcl-beginning-of-defun + (if tcl-using-emacs-19 + 'beginning-of-defun + 'tcl-internal-beginning-of-defun)) + +;; Only FSF Emacs 19 works correctly using end-of-defun. Emacs 18 and +;; Lucid need our own function. +(fset 'tcl-end-of-defun + (if (and tcl-using-emacs-19 (not tcl-using-lemacs-19)) + 'end-of-defun + 'tcl-internal-end-of-defun)) + + + + +;; +;; Some helper functions. +;; + +(defun tcl-set-proc-regexp () + "Set `tcl-proc-regexp' from variable `tcl-proc-list'." + (setq tcl-proc-regexp (concat "^\\(" + (mapconcat 'identity tcl-proc-list "\\|") + "\\)[ \t]+"))) + +(defun tcl-set-font-lock-keywords () + "Set `tcl-font-lock-keywords'. +Uses variables `tcl-proc-regexp' and `tcl-keyword-list'." + (setq tcl-font-lock-keywords + (list + ;; Names of functions (and other "defining things"). + (list (concat tcl-proc-regexp "\\([^ \t\n]+\\)") + 2 'font-lock-function-name-face) + + ;; Names of type-defining things. + (list (concat "\\(\\s-\\|^\\)\\(" + ;; FIXME Use 'regexp-quote? + (mapconcat 'identity tcl-typeword-list "\\|") + "\\)\\(\\s-\\|$\\)") + 2 'font-lock-type-face) + + ;; Keywords. Only recognized if surrounded by whitespace. + ;; FIXME consider using "not word or symbol", not + ;; "whitespace". + (cons (concat "\\(\\s-\\|^\\)\\(" + ;; FIXME Use regexp-quote? + (mapconcat 'identity tcl-keyword-list "\\|") + "\\)\\(\\s-\\|$\\)") + 2) + ))) + +(if tcl-proc-regexp + () + (tcl-set-proc-regexp)) + +(if tcl-font-lock-keywords + () + (tcl-set-font-lock-keywords)) + + + + + +;; +;; The mode itself. +;; + +(defun tcl-mode () + "Major mode for editing Tcl code. +Expression and list commands understand all Tcl brackets. +Tab indents for Tcl code. +Paragraphs are separated by blank lines only. +Delete converts tabs to spaces as it moves back. + +Variables controlling indentation style: + tcl-indent-level + Indentation of Tcl statements within surrounding block. + tcl-continued-indent-level + Indentation of continuation line relative to first line of command. + +Variables controlling user interaction with mode (see variable +documentation for details): + tcl-tab-always-indent + Controls action of TAB key. + tcl-auto-newline + Non-nil means automatically newline before and after braces, brackets, + and semicolons inserted in Tcl code. + tcl-electric-hash-style + Controls action of `#' key. + tcl-use-hairy-comment-detector + If t, use more complicated, but slower, comment detector. + This variable is only used in GNU Emacs 19. + +Turning on Tcl mode calls the value of the variable `tcl-mode-hook' +with no args, if that value is non-nil. Read the documentation for +`tcl-mode-hook' to see what kinds of interesting hook functions +already exist. + +Commands: +\\{tcl-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map tcl-mode-map) + (setq major-mode 'tcl-mode) + (setq mode-name "Tcl") + (setq local-abbrev-table tcl-mode-abbrev-table) + (set-syntax-table tcl-mode-syntax-table) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'tcl-indent-line) + ;; Tcl doesn't require a final newline. + ;; (make-local-variable 'require-final-newline) + ;; (setq require-final-newline t) + (make-local-variable 'comment-start) + (setq comment-start "# ") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "#+ *") + (make-local-variable 'comment-column) + (setq comment-column 40) + (make-local-variable 'comment-end) + (setq comment-end "") + (make-local-variable 'font-lock-keywords) + (setq font-lock-keywords tcl-font-lock-keywords) + (setq imenu-create-index-function 'tcl-imenu-create-index-function) + (make-local-variable 'parse-sexp-ignore-comments) + (if tcl-using-emacs-19 + (progn + ;; This can only be set to t in Emacs 19 and Lucid Emacs. + ;; Emacs 18 and Epoch lose. + (setq parse-sexp-ignore-comments t) + ;; Lucid Emacs has defun-prompt-regexp, but I don't believe + ;; that it works for end-of-defun -- only for + ;; beginning-of-defun. + (make-local-variable 'defun-prompt-regexp) + (setq defun-prompt-regexp tcl-omit-ws-regexp) + ;; The following doesn't work in Lucid Emacs 19.6, but maybe + ;; it will appear in later versions. + (make-local-variable 'add-log-current-defun-function) + (setq add-log-current-defun-function 'add-log-tcl-defun)) + (setq parse-sexp-ignore-comments nil)) + (run-hooks 'tcl-mode-hook)) + + + + + + + + + + + + + +;; This is used for braces, brackets, and semi (except for closing +;; braces, which are handled specially). +(defun tcl-electric-char (arg) + "Insert character and correct line's indentation." + (interactive "p") + ;; Indent line first; this looks better if parens blink. + (tcl-indent-line) + (self-insert-command arg) + (if (and tcl-auto-newline (= last-command-char ?\;)) + (progn + (newline) + (tcl-indent-line)))) + +;; This is used for closing braces. If tcl-auto-newline is set, can +;; insert a newline both before and after the brace, depending on +;; context. FIXME should this be configurable? Does anyone use this? +(defun tcl-electric-brace (arg) + "Insert character and correct line's indentation." + (interactive "p") + ;; If auto-newlining and there is stuff on the same line, insert a + ;; newline first. + (if tcl-auto-newline + (progn + (if (save-excursion + (skip-chars-backward " \t") + (bolp)) + () + (tcl-indent-line) + (newline)) + ;; In auto-newline case, must insert a newline after each + ;; brace. So an explicit loop is needed. + (while (> arg 0) + (insert last-command-char) + (tcl-indent-line) + (newline) + (setq arg (1- arg)))) + (self-insert-command arg)) + (tcl-indent-line)) + + + + + + + + + + +(defun tcl-indent-command (&optional arg) + "Indent current line as Tcl code, or in some cases insert a tab character. +If tcl-tab-always-indent is t (the default), always indent current line. +If tcl-tab-always-indent is nil and point is not in the indentation +area at the beginning of the line, a TAB is inserted. +Other values of tcl-tab-always-indent cause the first possible action +from the following list to take place: + + 1. Move from beginning of line to correct indentation. + 2. Delete an empty comment. + 3. Move forward to start of comment, indenting if necessary. + 4. Move forward to end of line, indenting if necessary. + 5. Create an empty comment. + 6. Move backward to start of comment, indenting if necessary." + (interactive "p") + (cond + ((not tcl-tab-always-indent) + ;; Indent if in identation area, otherwise insert TAB. + (if (<= (current-column) (current-indentation)) + (tcl-indent-line) + (self-insert-command arg))) + ((eq tcl-tab-always-indent t) + ;; Always indent. + (tcl-indent-line)) + (t + ;; "Perl-mode" style TAB command. + (let* ((ipoint (point)) + (eolpoint (progn + (end-of-line) + (point))) + (comment-p (tcl-in-comment))) + (cond + ((= ipoint (save-excursion + (beginning-of-line) + (point))) + (beginning-of-line) + (tcl-indent-line) + ;; If indenting didn't leave us in column 0, go to the + ;; indentation. Otherwise leave point at end of line. This + ;; is a hack. + (if (= (point) (save-excursion + (beginning-of-line) + (point))) + (end-of-line) + (back-to-indentation))) + ((and comment-p (looking-at "[ \t]*$")) + ;; Empty comment, so delete it. We also delete any ";" + ;; characters at the end of the line. I think this is + ;; friendlier, but I don't know how other people will feel. + (backward-char) + (skip-chars-backward " \t;") + (delete-region (point) eolpoint)) + ((and comment-p (< ipoint (point))) + ;; Before comment, so skip to it. + (tcl-indent-line) + (indent-for-comment)) + ((/= ipoint eolpoint) + ;; Go to end of line (since we're not there yet). + (goto-char eolpoint) + (tcl-indent-line)) + ((not comment-p) + ;; Create an empty comment (since there isn't one on this + ;; line). If line is not blank, make sure we insert a ";" + ;; first. + (beginning-of-line) + (if (/= (point) eolpoint) + (progn + (goto-char eolpoint) + (or (tcl-real-command-p) + (insert ";")))) + (tcl-indent-line) + (indent-for-comment)) + (t + ;; Go to start of comment. We don't leave point where it is + ;; because we want to skip comment-start-skip. + (tcl-indent-line) + (indent-for-comment))))))) + +(defun tcl-indent-line () + "Indent current line as Tcl code. +Return the amount the indentation changed by." + (let ((indent (calculate-tcl-indent nil)) + beg shift-amt + (case-fold-search nil) + (pos (- (point-max) (point)))) + (beginning-of-line) + (setq beg (point)) + (cond ((eq indent nil) + (setq indent (current-indentation))) + (t + (skip-chars-forward " \t") + (if (listp indent) (setq indent (car indent))) + (cond ((= (following-char) ?}) + (setq indent (- indent tcl-indent-level))) + ((= (following-char) ?\]) + (setq indent (- indent 1)))))) + (skip-chars-forward " \t") + (setq shift-amt (- indent (current-column))) + (if (zerop shift-amt) + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + (delete-region beg (point)) + (indent-to indent) + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))) + shift-amt)) + +(defun tcl-figure-type () + "Determine type of sexp at point. +This is either 'tcl-expr, 'tcl-commands, or nil. Puts point at start +of sexp that indicates types. + +See documentation for variable `tcl-type-alist' for more information." + (let ((count 0) + result + word-stack) + (while (and (< count 5) + (not result)) + (condition-case nil + (progn + ;; FIXME should use "tcl-backward-sexp", which would skip + ;; over entire variables, etc. + (backward-sexp) + (if (looking-at "[a-zA-Z_]+") + (let ((list tcl-type-alist) + entry) + (setq word-stack (cons (current-word) word-stack)) + (while (and list (not result)) + (setq entry (car list)) + (setq list (cdr list)) + (let ((index 0)) + (while (and entry (<= index count)) + ;; Abort loop if string does not match word on + ;; stack. + (and (stringp (car entry)) + (not (string= (car entry) + (nth index word-stack))) + (setq entry nil)) + (setq entry (cdr entry)) + (setq index (1+ index))) + (and (> index count) + (not (stringp (car entry))) + (setq result (car entry))) + ))) + (setq word-stack (cons nil word-stack)))) + (error nil)) + (setq count (1+ count))) + (and tcl-explain-indentation + (message "Indentation type %s" result)) + result)) + +(defun calculate-tcl-indent (&optional parse-start) + "Return appropriate indentation for current line as Tcl code. +In usual case returns an integer: the column to indent to. +Returns nil if line starts inside a string, t if in a comment." + (save-excursion + (beginning-of-line) + (let* ((indent-point (point)) + (case-fold-search nil) + (continued-line + (save-excursion + (if (bobp) + nil + (backward-char) + (= ?\\ (preceding-char))))) + (continued-indent-value (if continued-line + tcl-continued-indent-level + 0)) + state + containing-sexp + found-next-line) + (if parse-start + (goto-char parse-start) + (tcl-beginning-of-defun)) + (while (< (point) indent-point) + (setq parse-start (point)) + (setq state (parse-partial-sexp (point) indent-point 0)) + (setq containing-sexp (car (cdr state)))) + (cond ((or (nth 3 state) (nth 4 state)) + ;; Inside comment or string. Return nil or t if should + ;; not change this line + (nth 4 state)) + ((null containing-sexp) + ;; Line is at top level. + continued-indent-value) + (t + ;; Set expr-p if we are looking at the expression part of + ;; an "if", "expr", etc statement. Set commands-p if we + ;; are looking at the body part of an if, while, etc + ;; statement. FIXME Should check for "for" loops here. + (goto-char containing-sexp) + (let* ((sexpr-type (tcl-figure-type)) + (expr-p (eq sexpr-type 'tcl-expr)) + (commands-p (eq sexpr-type 'tcl-commands)) + (expr-start (point))) + ;; Find the first statement in the block and indent + ;; like it. The first statement in the block might be + ;; on the same line, so what we do is skip all + ;; "virtually blank" lines, looking for a non-blank + ;; one. A line is virtually blank if it only contains + ;; a comment and whitespace. FIXME continued comments + ;; aren't supported. They are a wart on Tcl anyway. + ;; We do it this funky way because we want to know if + ;; we've found a statement on some line _after_ the + ;; line holding the sexp opener. + (goto-char containing-sexp) + (forward-char) + (if (and (< (point) indent-point) + (looking-at "[ \t]*\\(#.*\\)?$")) + (progn + (forward-line) + (while (and (< (point) indent-point) + (looking-at "[ \t]*\\(#.*\\)?$")) + (setq found-next-line t) + (forward-line)))) + (if (or continued-line + (/= (char-after containing-sexp) ?{) + expr-p) + (progn + ;; Line is continuation line, or the sexp opener + ;; is not a curly brace, or we are are looking at + ;; an `expr' expression (which must be split + ;; specially). So indentation is column of first + ;; good spot after sexp opener (with some added + ;; in the continued-line case). If there is no + ;; nonempty line before the indentation point, we + ;; use the column of the character after the sexp + ;; opener. + (if (>= (point) indent-point) + (progn + (goto-char containing-sexp) + (forward-char)) + (skip-chars-forward " \t")) + (+ (current-column) continued-indent-value)) + ;; After a curly brace, and not a continuation line. + ;; So take indentation from first good line after + ;; start of block, unless that line is on the same + ;; line as the opening brace. In this case use the + ;; indentation of the opening brace's line, plus + ;; another indent step. If we are in the body part + ;; of an "if" or "while" then the indentation is + ;; taken from the line holding the start of the + ;; statement. + (if (and (< (point) indent-point) + found-next-line) + (current-indentation) + (if commands-p + (goto-char expr-start) + (goto-char containing-sexp)) + (+ (current-indentation) tcl-indent-level))))))))) + + + + + + + + + + + + +(defun mark-tcl-function () + "Put mark at end of Tcl function, point at beginning." + (interactive) + (push-mark (point)) + (tcl-end-of-defun) + (if tcl-using-emacs-19 + (push-mark (point) nil t) + (push-mark (point))) + (tcl-beginning-of-defun) + (backward-paragraph)) + + + + + + + + + + + + + + +(defun indent-tcl-exp () + "Indent each line of the Tcl grouping following point." + (interactive) + (let ((indent-stack (list nil)) + (contain-stack (list (point))) + (case-fold-search nil) + outer-loop-done inner-loop-done state ostate + this-indent last-sexp continued-line + (next-depth 0) + last-depth) + (save-excursion + (forward-sexp 1)) + (save-excursion + (setq outer-loop-done nil) + (while (and (not (eobp)) (not outer-loop-done)) + (setq last-depth next-depth) + ;; Compute how depth changes over this line + ;; plus enough other lines to get to one that + ;; does not end inside a comment or string. + ;; Meanwhile, do appropriate indentation on comment lines. + (setq inner-loop-done nil) + (while (and (not inner-loop-done) + (not (and (eobp) (setq outer-loop-done t)))) + (setq ostate state) + (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) + nil nil state)) + (setq next-depth (car state)) + (if (and (car (cdr (cdr state))) + (>= (car (cdr (cdr state))) 0)) + (setq last-sexp (car (cdr (cdr state))))) + (if (or (nth 4 ostate)) + (tcl-indent-line)) + (if (or (nth 3 state)) + (forward-line 1) + (setq inner-loop-done t))) + (if (<= next-depth 0) + (setq outer-loop-done t)) + (if outer-loop-done + nil + ;; If this line had ..))) (((.. in it, pop out of the levels + ;; that ended anywhere in this line, even if the final depth + ;; doesn't indicate that they ended. + (while (> last-depth (nth 6 state)) + (setq indent-stack (cdr indent-stack) + contain-stack (cdr contain-stack) + last-depth (1- last-depth))) + (if (/= last-depth next-depth) + (setq last-sexp nil)) + ;; Add levels for any parens that were started in this line. + (while (< last-depth next-depth) + (setq indent-stack (cons nil indent-stack) + contain-stack (cons nil contain-stack) + last-depth (1+ last-depth))) + (if (null (car contain-stack)) + (setcar contain-stack + (or (car (cdr state)) + (save-excursion + (forward-sexp -1) + (point))))) + (forward-line 1) + (setq continued-line + (save-excursion + (backward-char) + (= (preceding-char) ?\\))) + (skip-chars-forward " \t") + (if (eolp) + nil + (if (and (car indent-stack) + (>= (car indent-stack) 0)) + ;; Line is on an existing nesting level. + (setq this-indent (car indent-stack)) + ;; Just started a new nesting level. + ;; Compute the standard indent for this level. + (let ((val (calculate-tcl-indent + (if (car indent-stack) + (- (car indent-stack)))))) + (setcar indent-stack + (setq this-indent val)) + (setq continued-line nil))) + (cond ((not (numberp this-indent))) + ((= (following-char) ?}) + (setq this-indent (- this-indent tcl-indent-level))) + ((= (following-char) ?\]) + (setq this-indent (- this-indent 1)))) + ;; Put chosen indentation into effect. + (or (null this-indent) + (= (current-column) + (if continued-line + (+ this-indent tcl-indent-level) + this-indent)) + (progn + (delete-region (point) (progn (beginning-of-line) (point))) + (indent-to + (if continued-line + (+ this-indent tcl-indent-level) + this-indent))))))))) + ) + + + + + + + + + + + + + + + + + + + + + + + +;; +;; Interfaces to other packages. +;; + +(defun tcl-imenu-create-index-function () + "Generate alist of indices for imenu." + (let ((re (concat tcl-proc-regexp "\\([^ \t\n{]+\\)")) + alist) + (imenu-progress-message 0) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (imenu-progress-message nil) + ;; Position on start of proc name, not beginning of line. + (setq alist (cons + (cons (buffer-substring (match-beginning 2) (match-end 2)) + (match-beginning 2)) + alist))) + (imenu-progress-message 100) + (nreverse alist))) + +;; FIXME Definition of function is very ad-hoc. Should use +;; tcl-beginning-of-defun. Also has incestuous knowledge about the +;; format of tcl-proc-regexp. +(defun add-log-tcl-defun () + "Return name of Tcl function point is in, or nil." + (save-excursion + (if (re-search-backward + (concat tcl-proc-regexp "\\([^ \t\n{]+\\)") nil t) + (buffer-substring (match-beginning 2) + (match-end 2))))) + + + + + + + + + + + + + + + + + + +;; +;; Helper functions for inferior Tcl mode. +;; + +;; This exists to let us delete the prompt when commands are sent +;; directly to the inferior Tcl. See gud.el for an explanation of how +;; it all works (I took it from there). This stuff doesn't really +;; work as well as I'd like it to. But I don't believe there is +;; anything useful that can be done. +(defvar inferior-tcl-delete-prompt-marker nil) + +(defun tcl-filter (proc string) + (let ((inhibit-quit t)) + (save-excursion + (set-buffer (process-buffer proc)) + (goto-char (process-mark proc)) + ;; Delete prompt if requested. + (if (marker-buffer inferior-tcl-delete-prompt-marker) + (progn + (delete-region (point) inferior-tcl-delete-prompt-marker) + (set-marker inferior-tcl-delete-prompt-marker nil))))) + (comint-output-filter proc string)) + +(defun tcl-send-string (proc string) + (save-excursion + (set-buffer (process-buffer proc)) + (goto-char (process-mark proc)) + (beginning-of-line) + (if (looking-at comint-prompt-regexp) + (set-marker inferior-tcl-delete-prompt-marker (point)))) + (comint-send-string proc string)) + +(defun tcl-send-region (proc start end) + (save-excursion + (set-buffer (process-buffer proc)) + (goto-char (process-mark proc)) + (beginning-of-line) + (if (looking-at comint-prompt-regexp) + (set-marker inferior-tcl-delete-prompt-marker (point)))) + (comint-send-region proc start end)) + +(defun switch-to-tcl (eob-p) + "Switch to inferior Tcl process buffer. +With argument, positions cursor at end of buffer." + (interactive "P") + (if (get-buffer inferior-tcl-buffer) + (pop-to-buffer inferior-tcl-buffer) + (error "No current inferior Tcl buffer")) + (cond (eob-p + (push-mark) + (goto-char (point-max))))) + +(defun inferior-tcl-proc () + "Return current inferior Tcl process. +See variable `inferior-tcl-buffer'." + (let ((proc (get-buffer-process (if (eq major-mode 'inferior-tcl-mode) + (current-buffer) + inferior-tcl-buffer)))) + (or proc + (error "No Tcl process; see variable `inferior-tcl-buffer'")))) + +(defun tcl-eval-region (start end &optional and-go) + "Send the current region to the inferior Tcl process. +Prefix argument means switch to the Tcl buffer afterwards." + (interactive "r\nP") + (let ((proc (inferior-tcl-proc))) + (tcl-send-region proc start end) + (tcl-send-string proc "\n") + (if and-go (switch-to-tcl t)))) + +(defun tcl-eval-defun (&optional and-go) + "Send the current defun to the inferior Tcl process. +Prefix argument means switch to the Tcl buffer afterwards." + (interactive "P") + (save-excursion + (tcl-end-of-defun) + (let ((end (point))) + (tcl-beginning-of-defun) + (tcl-eval-region (point) end))) + (if and-go (switch-to-tcl t))) + + + + + + + + + + + + + + + + +;; +;; Inferior Tcl mode itself. +;; + +(defun inferior-tcl-mode () + "Major mode for interacting with Tcl interpreter. + +A Tcl process can be started with M-x inferior-tcl. + +Entry to this mode runs the hooks comint-mode-hook and +inferior-tcl-mode-hook, in that order. + +You can send text to the inferior Tcl process from other buffers +containing Tcl source. + +Variables controlling Inferior Tcl mode: + tcl-application + Name of program to run. + tcl-command-switches + Command line arguments to `tcl-application'. + tcl-prompt-regexp + Matches prompt. + inferior-tcl-source-command + Command to use to read Tcl file in running application. + inferior-tcl-buffer + The current inferior Tcl process buffer. See variable + documentation for details on multiple-process support. + +The following commands are available: +\\{inferior-tcl-mode-map}" + (interactive) + (comint-mode) + (setq comint-prompt-regexp (or tcl-prompt-regexp + (concat "^" + (regexp-quote tcl-application) + ">"))) + (setq major-mode 'inferior-tcl-mode) + (setq mode-name "Inferior Tcl") + (setq mode-line-process '(": %s")) + (use-local-map inferior-tcl-mode-map) + (setq local-abbrev-table tcl-mode-abbrev-table) + (set-syntax-table tcl-mode-syntax-table) + (if tcl-using-emacs-19 + (progn + (make-local-variable 'defun-prompt-regexp) + (setq defun-prompt-regexp tcl-omit-ws-regexp))) + (make-local-variable 'inferior-tcl-delete-prompt-marker) + (setq inferior-tcl-delete-prompt-marker (make-marker)) + (set-process-filter (get-buffer-process (current-buffer)) 'tcl-filter) + (run-hooks 'inferior-tcl-mode-hook)) + +(defun inferior-tcl (cmd) + "Run inferior Tcl process. +Prefix arg means enter program name interactively. +See documentation for function `inferior-tcl-mode' for more information." + (interactive + (list (if current-prefix-arg + (read-string "Run Tcl: " tcl-application) + tcl-application))) + (if (not (comint-check-proc "*inferior-tcl*")) + (progn + (set-buffer (apply (function make-comint) "inferior-tcl" cmd nil + tcl-command-switches)) + (inferior-tcl-mode))) + (make-local-variable 'tcl-application) + (setq tcl-application cmd) + (setq inferior-tcl-buffer "*inferior-tcl*") + (switch-to-buffer "*inferior-tcl*")) + +(and (fboundp 'defalias) + (defalias 'run-tcl 'inferior-tcl)) + + + + + + + + + + + + + + + + + + + + + + + + + +;; +;; Auto-fill support. +;; + +(defun tcl-real-command-p () + "Return nil if point is not at the beginning of a command. +A command is the first word on an otherwise empty line, or the +first word following a semicolon, opening brace, or opening bracket." + (save-excursion + (skip-chars-backward " \t") + (cond + ((bobp) t) + ((bolp) + (backward-char) + ;; Note -- continued comments are not supported here. I + ;; consider those to be a wart on the language. + (not (eq ?\\ (preceding-char)))) + (t + (memq (preceding-char) '(?\; ?{ ?\[)))))) + +;; FIXME doesn't actually return t. See last case. +(defun tcl-real-comment-p () + "Return t if point is just after the `#' beginning a real comment. +Does not check to see if previous char is actually `#'. +A real comment is either at the beginning of the buffer, +preceeded only by whitespace on the line, or has a preceeding +semicolon, opening brace, or opening bracket on the same line." + (save-excursion + (backward-char) + (tcl-real-command-p))) + +(defun tcl-hairy-scan-for-comment (state end always-stop) + "Determine if point is in a comment. +Returns a list of the form `(FLAG . STATE)'. STATE can be used +as input to future invocations. FLAG is nil if not in comment, +t otherwise. If in comment, leaves point at beginning of comment. +Only works in Emacs 19. See also `tcl-simple-scan-for-comment', a +simpler version that is often right, and works in Emacs 18." + (let ((bol (save-excursion + (goto-char end) + (beginning-of-line) + (point))) + real-comment + last-cstart) + (while (and (not last-cstart) (< (point) end)) + (setq real-comment nil) ;In case we've looped around and it is + ;set. + (setq state (parse-partial-sexp (point) end nil nil state t)) + (if (nth 4 state) + (progn + ;; If ALWAYS-STOP is set, stop even if we don't have a + ;; real comment, or if the comment isn't on the same line + ;; as the end. + (if always-stop (setq last-cstart (point))) + ;; If we have a real comment, then set the comment + ;; starting point if we are on the same line as the ending + ;; location. + (setq real-comment (tcl-real-comment-p)) + (if real-comment + (progn + (and (> (point) bol) (setq last-cstart (point))) + ;; NOTE Emacs 19 has a misfeature whereby calling + ;; parse-partial-sexp with COMMENTSTOP set and with + ;; an initial list that says point is in a comment + ;; will cause an immediate return. So we must skip + ;; over the comment ourselves. + (beginning-of-line 2))) + ;; Frob the state to make it look like we aren't in a + ;; comment. + (setcar (nthcdr 4 state) nil)))) + (and last-cstart + (goto-char last-cstart)) + (cons real-comment state))) + +(defun tcl-hairy-in-comment () + "Return t if point is in a comment, and leave point at beginning +of comment." + (let ((save (point))) + (tcl-beginning-of-defun) + (car (tcl-hairy-scan-for-comment nil save nil)))) + +(defun tcl-simple-in-comment () + "Return t if point is in comment, and leave point at beginning +of comment. This is faster that `tcl-hairy-in-comment', but is +correct less often." + (let ((save (point)) + comment) + (beginning-of-line) + (while (and (< (point) save) (not comment)) + (search-forward "#" save 'move) + (setq comment (tcl-real-comment-p))) + comment)) + +(defun tcl-in-comment () + "Return t if point is in comment, and leave point at beginning +of comment." + (if (and tcl-pps-has-arg-6 + tcl-use-hairy-comment-detector) + (tcl-hairy-in-comment) + (tcl-simple-in-comment))) + +(defun tcl-do-auto-fill () + "Auto-fill function for Tcl mode. Only auto-fills in a comment." + (let (in-comment + col) + (save-excursion + (setq in-comment (tcl-in-comment)) + (if in-comment + (setq col (1- (current-column))))) + (if in-comment + (progn + (do-auto-fill) + (save-excursion + (back-to-indentation) + (delete-region (point) (save-excursion + (beginning-of-line) + (point))) + (indent-to-column col)))))) + + + + + + + + + + + + + + + + + + + + + + + + + + +;; +;; Help-related code. +;; + +(defvar tcl-help-saved-dir nil + "Saved help directory. If `tcl-help-directory' changes, this allows +tcl-help-on-word to update the alist") + +(defvar tcl-help-alist nil + "Alist with command names as keys and filenames as values.") + +(defun tcl-help-snarf-commands (dir) + "Build alist of commands and filenames. There is probably a much +better implementation of this, but I'm too tired to think of it right +now." + (let ((files (directory-files dir t))) + (while files + (if (and (file-directory-p (car files)) + (not + (let ((fpart (file-name-nondirectory (car files)))) + (or (equal fpart ".") + (equal fpart ".."))))) + (let ((matches (directory-files (car files) t))) + (while matches + (or (file-directory-p (car matches)) + (setq tcl-help-alist + (cons + (cons (file-name-nondirectory (car matches)) + (car matches)) + tcl-help-alist))) + (setq matches (cdr matches))))) + (setq files (cdr files))))) + +(defun tcl-reread-help-files () + "Set up to re-read files, and then do it." + (interactive) + (message "Building Tcl help file index...") + (setq tcl-help-saved-dir tcl-help-directory) + (setq tcl-help-alist nil) + (tcl-help-snarf-commands tcl-help-directory) + (message "Building Tcl help file index...done")) + +(defun tcl-current-word (flag) + "Return current command word, or nil. +If FLAG is nil, just uses `current-word'. +Otherwise scans backward for most likely Tcl command word." + (if (and flag (eq major-mode 'tcl-mode)) + (condition-case nil + (save-excursion + ;; Look backward for first word actually in alist. + (if (bobp) + () + (while (and (not (bobp)) + (not (tcl-real-command-p))) + (backward-sexp))) + (if (assoc (current-word) tcl-help-alist) + (current-word))) + (error nil)) + (current-word))) + +(defun tcl-help-on-word (command &optional arg) + "Get help on Tcl command. Default is word at point. +Prefix argument means invert sense of `tcl-use-smart-word-finder'." + (interactive + (list + (progn + (if (not (string= tcl-help-directory tcl-help-saved-dir)) + (tcl-reread-help-files)) + (let ((word (tcl-current-word + (if current-prefix-arg + (not tcl-use-smart-word-finder) + tcl-use-smart-word-finder)))) + (completing-read + (if (or (null word) (string= word "")) + "Help on Tcl command: " + (format "Help on Tcl command (default %s): " word)) + tcl-help-alist nil t))) + current-prefix-arg)) + (if (not (string= tcl-help-directory tcl-help-saved-dir)) + (tcl-reread-help-files)) + (if (string= command "") + (setq command (tcl-current-word + (if arg + (not tcl-use-smart-word-finder) + tcl-use-smart-word-finder)))) + (let* ((help (get-buffer-create "*Tcl help*")) + (cell (assoc command tcl-help-alist)) + (file (and cell (cdr cell)))) + (set-buffer help) + (delete-region (point-min) (point-max)) + (if file + (progn + (insert "*** " command "\n\n") + (insert-file-contents file)) + (if (string= command "") + (insert "Magical Pig!") + (insert "Tcl command " command " not in help\n"))) + (set-buffer-modified-p nil) + (goto-char (point-min)) + (display-buffer help))) + + + + + + + + + + + + + + + + + + + + +;; +;; Other interactive stuff. +;; + +(defvar tcl-previous-dir/file nil + "Record last directory and file used in loading. +This holds a cons cell of the form `(DIRECTORY . FILE)' +describing the last `tcl-load-file' command.") + +(defun tcl-load-file (file &optional and-go) + "Load a Tcl file into the inferior Tcl process. +Prefix argument means switch to the Tcl buffer afterwards." + (interactive + (list + ;; car because comint-get-source returns a list holding the + ;; filename. + (car (comint-get-source "Load Tcl file: " tcl-previous-dir/file + '(tcl-mode) t)) + current-prefix-arg)) + (comint-check-source file) + (setq tcl-previous-dir/file (cons (file-name-directory file) + (file-name-nondirectory file))) + (tcl-send-string (inferior-tcl-proc) + (format inferior-tcl-source-command (tcl-quote file))) + (if and-go (switch-to-tcl t))) + +;; Maybe this should work just like tcl-load-file. But I think what +;; I've implemented will turn out to be more useful. +(defun tcl-restart-with-file (file &optional and-go) + "Restart inferior Tcl with file. +If an inferior Tcl process exists, it is killed first. +Prefix argument means switch to the Tcl buffer afterwards." + (interactive + (list + (car (comint-get-source "Restart with Tcl file: " + (or (and + (eq major-mode 'tcl-mode) + (buffer-file-name)) + tcl-previous-dir/file) + '(tcl-mode) t)) + current-prefix-arg)) + (let* ((buf (if (eq major-mode 'inferior-tcl-mode) + (current-buffer) + inferior-tcl-buffer)) + (proc (and buf (get-process buf)))) + (cond + ((not (and buf (get-buffer buf))) + ;; I think this will be ok. + (inferior-tcl tcl-application) + (tcl-load-file file and-go)) + ((or + (not (comint-check-proc buf)) + (yes-or-no-p + "A Tcl process is running, are you sure you want to reset it? ")) + (save-excursion + (comint-check-source file) + (setq tcl-previous-dir/file (cons (file-name-directory file) + (file-name-nondirectory file))) + (comint-exec (get-buffer-create buf) + (if proc + (process-name proc) + "inferior-tcl") + tcl-application file tcl-command-switches) + (if and-go (switch-to-tcl t))))))) + +;; FIXME I imagine you can do this under Emacs 18. I just don't know +;; how. +(defun tcl-auto-fill-mode (&optional arg) + "Like `auto-fill-mode', but controls filling of Tcl comments." + (interactive "P") + (and (not tcl-using-emacs-19) + (error "You must use Emacs 19 to get this feature.")) + ;; Following code taken from "auto-fill-mode" (simple.el). + (prog1 + (setq auto-fill-function + (if (if (null arg) + (not auto-fill-function) + (> (prefix-numeric-value arg) 0)) + 'tcl-do-auto-fill + nil)) + ;; Update mode line. FIXME I'd use force-mode-line-update, but I + ;; don't know if it exists in v18. + (set-buffer-modified-p (buffer-modified-p)))) + +(defun tcl-electric-hash (&optional count) + "Insert a `#' and quote if it does not start a real comment. +Prefix arg is number of `#'s to insert. +See variable `tcl-electric-hash-style' for description of quoting +styles." + (interactive "p") + (or count (setq count 1)) + (if (> count 0) + (let ((type + (if (eq tcl-electric-hash-style 'smart) + (if (> count 3) ; FIXME what is "smart"? + 'quote + 'backslash) + tcl-electric-hash-style)) + comment) + (if type + (progn + (save-excursion + (insert "#") + (setq comment (tcl-in-comment))) + (delete-char 1) + (and tcl-explain-indentation (message "comment: %s" comment)) + (cond + ((eq type 'quote) + (if (not comment) + (insert "\""))) + ((eq type 'backslash) + ;; The following will set count to 0, so the + ;; insert-char can still be run. + (if (not comment) + (while (> count 0) + (insert "\\#") + (setq count (1- count))))) + (t nil)))) + (insert-char ?# count)))) + +(defun tcl-hashify-buffer () + "Quote all `#'s in current buffer that aren't Tcl comments." + (interactive) + (save-excursion + (goto-char (point-min)) + (if (and tcl-pps-has-arg-6 tcl-use-hairy-comment-detector) + (let (state + result) + (while (< (point) (point-max)) + (setq result (tcl-hairy-scan-for-comment state (point-max) t)) + (if (car result) + (beginning-of-line 2) + (backward-char) + (if (eq ?# (following-char)) + (insert "\\")) + (forward-char)) + (setq state (cdr result)))) + (while (and (< (point) (point-max)) + (search-forward "#" nil 'move)) + (if (tcl-real-comment-p) + (beginning-of-line 2) + ;; There's really no good way for the simple converter to + ;; work. So we just quote # if it isn't already quoted. + ;; Bogus, but it works. + (backward-char) + (if (not (eq ?\\ (preceding-char))) + (insert "\\")) + (forward-char)))))) + +;; The following was inspired by the Tcl editing mode written by +;; Gregor Schmid . His version also +;; attempts to snarf the command line options from the command line, +;; but I didn't think that would really be that helpful (doesn't seem +;; like it owould be right enough. His version also looks for the +;; "#!/bin/csh ... exec" hack, but that seemed even less useful. +(defun tcl-guess-application () + "Attempt to guess Tcl application by looking at first line. +The first line is assumed to look like \"#!.../program ...\"." + (save-excursion + (goto-char (point-min)) + (if (looking-at "#![^ \t]*/\\([^ \t/]+\\)\\([ \t]\\|$\\)") + (progn + (make-local-variable 'tcl-application) + (setq tcl-application (buffer-substring (match-beginning 1) + (match-end 1))))))) + +;; This only exists to put on the menubar. I couldn't figure out any +;; other way to do it. FIXME should take "number of #-marks" +;; argument. +(defun tcl-uncomment-region (beg end) + "Uncomment region." + (interactive "r") + (comment-region beg end -1)) + + + + + + + + + + + + + + + + + + + +;; +;; Lucid menu support. +;; Taken from schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid), +;; who wrote a different Tcl mode. +;; We also have simple support for menus in FSF. We do this by +;; loading the Lucid menu emulation code. +;; + +;; Put this into your tcl-mode-hook. +(defun tcl-install-menubar () + (and tcl-using-emacs-19 + (not tcl-using-lemacs-19) + (if tcl-using-emacs-19.23 + (require 'lmenu) + ;; CAVEATS: + ;; * lmenu.el provides 'menubar, which is bogus. + ;; * lmenu.el causes menubars to be turned on everywhere. + ;; Doubly bogus! + ;; Both of these problems are fixed in Emacs 19.23. People + ;; using an Emacs before that just suffer. + (require 'menubar "lmenu"))) + (if (not (assoc "Tcl" current-menubar)) + (progn + (set-buffer-menubar (copy-sequence current-menubar)) + (add-menu nil "Tcl" (cdr tcl-lucid-menu)))) + ;; You might want to do something like the below. I have it + ;; commented out because it overrides existing bindings. + ;; For Lucid: + ;; (define-key tcl-mode-map 'button3 'tcl-popup-menu) + ;; For FSF: + ;; (define-key tcl-mode-map [down-mouse-3] 'tcl-popup-menu) + ) + +(defun tcl-popup-menu (e) + (interactive "e") + (and tcl-using-emacs-19 + (not tcl-using-lemacs-19) + (if tcl-using-emacs-19.23 + (require 'lmenu) + ;; CAVEATS: + ;; * lmenu.el provides 'menubar, which is bogus. + ;; * lmenu.el causes menubars to be turned on everywhere. + ;; Doubly bogus! + ;; Both of these problems are fixed in Emacs 19.23. People + ;; using an Emacs before that just suffer. + (require 'menubar "lmenu"))) ;; This is annoying + ;;(mouse-set-point e) + ;; IMHO popup-menu should be autoloaded. Oh well. + (popup-menu tcl-lucid-menu)) + + + + + + + + + + + + + + + + + + + + + + + +;; +;; Quoting and unquoting functions. +;; + +;; This quoting is sufficient to protect eg a filename from any sort +;; of expansion or splitting. Tcl quoting sure sucks. +(defun tcl-quote (string) + "Quote STRING according to Tcl rules." + (mapconcat (function (lambda (char) + (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ? ?\;)) + (concat "\\" (char-to-string char)) + (char-to-string char)))) + string "")) + + +(provide 'tcl) + +;;; tcl.el ends here diff --git a/src/WOKsite/public_el/tclsh.el b/src/WOKsite/public_el/tclsh.el new file mode 100644 index 0000000..1f619fb --- /dev/null +++ b/src/WOKsite/public_el/tclsh.el @@ -0,0 +1,45 @@ +;;; tclsh.el --- add tclsh command to launch TCL shell + +(require 'comint) +(require 'shell) + +;; This function mostly duplicates original *shell* command +(defvar tclsh-program (getenv "TCLSH_EXE") + "*Name of program to invoke TCL shell") +(if (equal (getenv "WOKSTATION") "wnt") + (progn + (setq tclsh-program "tclsh85.exe"))) + +(defun tclsh (&optional buffer) + "Run TCL shell." + (interactive + (list + (and current-prefix-arg + (read-buffer "Shell buffer: " + (generate-new-buffer-name "*tclsh*"))))) + (setq buffer (get-buffer-create (or buffer "*tclsh*"))) + ;; Pop to buffer, so that the buffer's window will be correctly set + ;; when we call comint (so that comint sets the COLUMNS env var properly). + (pop-to-buffer buffer) + (unless (comint-check-proc buffer) + (let* ((prog tclsh-program) + (name (file-name-nondirectory prog)) + (startfile (concat "~/.emacs_" name)) + (xargs-name (intern-soft (concat "explicit-" name "-args")))) + (unless (file-exists-p startfile) + (setq startfile (concat "~/.emacs.d/init_" name ".sh"))) + (apply 'make-comint-in-buffer "tclsh" buffer prog + (if (file-exists-p startfile) startfile) + (if (and xargs-name (boundp xargs-name)) + (symbol-value xargs-name) + '("-i"))) + + ;; workaround concerning unproper work of tclsh under Emacs on Windows + (if (equal (getenv "WOKSTATION") "wnt") + (progn + (insert + (concat "source \"" (getenv "WOKHOME") "/site/interp.tcl\"")) + (comint-send-input))) + + (shell-mode))) + buffer) diff --git a/src/WOKsite/public_el/theme-dark.el b/src/WOKsite/public_el/theme-dark.el new file mode 100644 index 0000000..73e698d --- /dev/null +++ b/src/WOKsite/public_el/theme-dark.el @@ -0,0 +1,115 @@ +; dummy (set-mouse-color "White") +;; Colors for dark background for C++ and Emacs lisp +;; and syntax hylighting for C++ +;; NOTE: background color is to be defined elsewhere +;; Defines function det-reset-colors-dark, calls it +;; and defines keys A-q and M-q as shortcuts + +;(global-set-key [A-C-return] 'list-text-properties-at) +;(global-set-key [?\M-f] 'list-faces-display) + +(set-background-color "MidnightBlue") ;; background +(set-foreground-color "White") ;; text +(set-cursor-color "White") ;; text cursor +(set-mouse-color "White") ;; mouse cursor (frame-parameters) +;(setq x-pointer-shape 68) ;; select mouse cursor shape - does it work? + +;; C++ syntax hilighting +(hilit-set-mode-patterns + 'c++-mode + '( + ( "//.*$" nil comment ) +; ( "/[*]\\([^/]\\|\\([*][^/]\\)\\)*[*]/" nil comment ) + ( "#.*" nil string ) ; preprocessor +; ( "\"\\([^\\\"\n]\\|\\(\\$\\)\\)*\"" nil string ) + ( "\"(.*)[\"\n]" nil string ) +; ( "cout.*endl" nil decl ) +; ( "([0-9]+[.]?|[0-9]*[.][0-9]+)([EeDd][+-]?[0-9]+)?" nil decl ) + ( "\\<\\(\\(\\([0-9]+\\([.]?\\)\\)\\|\\([0-9]*[.]\\([0-9]+\\)\\)\\)\\([EeDd]\\([+-]?\\)\\([0-9]+\\)\\)?\\)\\>" nil decl ) +; ( "[0-9]+" nil decl ) +; ( "\\([^ (){}=\n]*\\)::\\([^ (){}=\n]*\\)" nil warning ) +; ( "\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|catch\\|try\\|new\\|const\\|static\\|class\\|struct\\|Handle\\)\\>" nil include ) + ( "\\<\\(return\\|return\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\)\\>" nil include ) + ( "\\<\\(catch\\|try\\|new\\|const\\|static\\|void\\|Handle\\|cin\\|cout\\|cerr\\|endl\\)\\>" nil include ) + ( "\\<\\(goto\\|public\\|private\\|protected\\|class\\|struct\\|enum\\|extern\\|int\\|char\\|float\\|double\\|short\\|long\\)\\>" nil include ) +; ( "(\\|)\\|[[]\\|[]]\\||\\|&\\|+\\|-\\|=\\|*\\|/" nil include ) +; ( "\\<[A-Za-z_][A-Za-z_0-9]*\\>" nil italic ) +; ( "\\<[0-9][A-Za-z_0-9]*\\>" nil error ) + () + nil 'case-sensitive + ) +) + +;; Colors for different text styles +;; NOTE: may need to change for different Emacs installations +(defun det-reset-colors-dark () "(Re)Set colors for dark background" (interactive) + (if (not (getenv "DISPLAY")) t + ;; csf favorite colors + ;; Face for keywords bold +; (set-face-foreground 'bold "cyan") + ;; Face for comments italic + ;;(make-face-italic 'italic) +; (set-face-foreground 'italic "bisque") + ;;Face for rubrics bold-italic +; (set-face-foreground 'bold-italic "gray30") +; (set-face-background 'bold-italic "gray80") + ;; Face for region highlighting + (set-face-underline-p 'region nil) ; t) + (set-face-foreground 'region "Black") + (set-face-background 'region "LightGray") + + (set-face-background 'default "MidnightBlue") + (set-face-foreground 'default "White") + + (or (facep 'RoyalBlue) + (make-face 'RoyalBlue)) + (set-face-foreground 'RoyalBlue "SkyBlue") ;; keywords in lisp + + (or (facep 'blue-bold) + (make-face 'blue-bold)) + (set-face-foreground 'blue-bold "SkyBlue") ;; defun's in lisp + (or (facep 'grey40) + (make-face 'grey40)) + (set-face-foreground 'grey40 "LimeGreen") ;; strings in lisp + +; (set-face-foreground 'blue-italic "Yellow") ;; identifiers in cxx + (or (facep 'purple) + (make-face 'purple)) + (set-face-foreground 'purple "SkyBlue") ;; keywords in cxx +; (set-face-foreground 'font-lock-reference-face "Green") ;; #include + (or (facep 'firebrick-italic) + (make-face 'firebrick-italic)) + (make-face-unitalic 'firebrick-italic) + + (set-face-foreground 'firebrick-italic "Magenta") ;; Orchid ;; comments // + (make-face-unitalic 'italic) + (set-face-foreground 'italic "Yellow") ;; identifiers in cxx + (and (string-match "linux" system-configuration) + (facep 'i-face) + (set-face-foreground 'i-face "Green") ;; Info messages in log files + ) + +; (set-face-foreground 'bold-italic "Red") + + (if (facep 'font-lock-string-face) + (progn + (set-face-foreground 'font-lock-string-face "LimeGreen") ;; strings in cxx + (set-face-foreground 'font-lock-type-face "SkyBlue") ;; ?? in cxx + (set-face-foreground 'font-lock-comment-face "Magenta") ;; Orchid ;; comments /* */ + (set-face-foreground 'font-lock-keyword-face "SkyBlue") ;; keyword in CDL + (set-face-foreground 'font-lock-function-name-face "Turquoise") ;; names in edl + (set-face-foreground 'font-lock-variable-name-face "Yellow") ;; variables in edl + ) + ) + ) +) + +(if (not (string-match "linux" system-configuration)) ;;"i386-mandrake-linux-gnu" + (det-reset-colors-dark) +) + +; set C++ highlighting for SWIG interface files (*.i) +(add-to-list 'auto-mode-alist '("\\.i$" . c++-mode)) + +(global-set-key [?\M-q] 'det-reset-colors-dark) +(global-set-key [?\A-q] 'det-reset-colors-dark) diff --git a/src/WOKsite/public_el/theme-kgv.el b/src/WOKsite/public_el/theme-kgv.el new file mode 100644 index 0000000..8134362 --- /dev/null +++ b/src/WOKsite/public_el/theme-kgv.el @@ -0,0 +1,88 @@ +;; Colors for dark background for C++ and Emacs lisp +;; and syntax hylighting for C++ +;; NOTE: background color is to be defined elsewhere +;; Defines function det-reset-colors-dark, calls it +;; and defines keys A-q and M-q as shortcuts + +;(global-set-key [A-C-return] 'list-text-properties-at) +;(global-set-key [?\M-f] 'list-faces-display) + +(set-background-color "MidnightBlue") ;; background +(set-foreground-color "White") ;; text +(set-cursor-color "White") ;; text cursor +(set-mouse-color "White") ;; mouse cursor (frame-parameters) +;(setq x-pointer-shape 68) ;; select mouse cursor shape - does it work? + +;; Colors for different text styles +;; NOTE: may need to change for different Emacs installations +(defun det-reset-colors-dark () "(Re)Set colors for dark background" (interactive) + (if (not (getenv "DISPLAY")) t + ;; csf favorite colors + ;; Face for keywords bold +; (set-face-foreground 'bold "cyan") + ;; Face for comments italic + ;;(make-face-italic 'italic) +; (set-face-foreground 'italic "bisque") + ;;Face for rubrics bold-italic +; (set-face-foreground 'bold-italic "gray30") +; (set-face-background 'bold-italic "gray80") + ;; Face for region highlighting + (set-face-underline-p 'region nil) ; t) + (set-face-foreground 'region "Black") + (set-face-background 'region "LightGray") + + (set-face-background 'default "MidnightBlue") + (set-face-foreground 'default "White") + + (or (facep 'RoyalBlue) + (make-face 'RoyalBlue)) + (set-face-foreground 'RoyalBlue "SkyBlue") ;; keywords in lisp + + (or (facep 'blue-bold) + (make-face 'blue-bold)) + (set-face-foreground 'blue-bold "SkyBlue") ;; defun's in lisp + (or (facep 'grey40) + (make-face 'grey40)) + (set-face-foreground 'grey40 "LimeGreen") ;; strings in lisp + +; (set-face-foreground 'blue-italic "Yellow") ;; identifiers in cxx + (or (facep 'purple) + (make-face 'purple)) + (set-face-foreground 'purple "SkyBlue") ;; keywords in cxx +; (set-face-foreground 'font-lock-reference-face "Green") ;; #include + (or (facep 'firebrick-italic) + (make-face 'firebrick-italic)) + (make-face-unitalic 'firebrick-italic) + + (set-face-foreground 'firebrick-italic "Magenta") ;; Orchid ;; comments // + (make-face-unitalic 'italic) + (set-face-foreground 'italic "Yellow") ;; identifiers in cxx + (and (string-match "linux" system-configuration) + (facep 'i-face) + (set-face-foreground 'i-face "Green") ;; Info messages in log files + ) + +; (set-face-foreground 'bold-italic "Red") + + (if (facep 'font-lock-string-face) + (progn + (set-face-foreground 'font-lock-string-face "LimeGreen") ;; strings in cxx + (set-face-foreground 'font-lock-type-face "SkyBlue") ;; ?? in cxx + (set-face-foreground 'font-lock-comment-face "Magenta") ;; Orchid ;; comments /* */ + (set-face-foreground 'font-lock-keyword-face "SkyBlue") ;; keyword in CDL + (set-face-foreground 'font-lock-function-name-face "Turquoise") ;; names in edl + (set-face-foreground 'font-lock-variable-name-face "Yellow") ;; variables in edl + ) + ) + ) +) + +(if (not (string-match "linux" system-configuration)) ;;"i386-mandrake-linux-gnu" + (det-reset-colors-dark) +) + +; set C++ highlighting for SWIG interface files (*.i) +(add-to-list 'auto-mode-alist '("\\.i$" . c++-mode)) + +(global-set-key [?\M-q] 'det-reset-colors-dark) +(global-set-key [?\A-q] 'det-reset-colors-dark) diff --git a/src/WOKsite/public_el/tree.el b/src/WOKsite/public_el/tree.el new file mode 100644 index 0000000..840d303 --- /dev/null +++ b/src/WOKsite/public_el/tree.el @@ -0,0 +1,686 @@ +;;; tree.el --- presentation and exploration of data having tree structure + +;;;Author : Edward AGAPOV +;;;History : Tue Dec 04 2001 Creation + +;;; Commentary + +;;; This is a base for major modes intended for presentation and exploration +;; of any data having tree structure. +;;; To use 'tree-mode for your own data, bind variables 'tree-get-ansestor, +;;; 'tree-has-descendants and 'tree-get-descendants-list to your functions +;;; either in 'tree-mode-hook or in buffer passed to 'tree-build-tree + +;;; Mode entrance function is 'tree-build-tree. To try 'tree-mode evaluate +;;; (tree-build-tree "1000" nil). + +;; customization variables ;; + +(defvar tree-get-ansestor nil + "*Function returning ansestor \(string) of item \(argument, string)" + ) +(defvar tree-has-descendants nil + "*Function returning not nil if an item (argument, string) has descendant(s)" + ) +(defvar tree-get-descendants-list nil + "*Function returning a list of item descendants (strings)" + ) +(defvar tree-keep-info t + "*t means that data got for an item through 'tree-get-ansestor and +'tree-get-descendants-list is stored internally and no more asked, so +that it can become out of date if changes after last call " + ) +(defvar tree-top-margin 2 + "*Number of empty top lines" + ) +(defvar tree-level-width 4 + "*Number of columns between neighbour level branches" + ) + +(make-variable-buffer-local 'tree-get-ansestor) +(make-variable-buffer-local 'tree-has-descendants) +(make-variable-buffer-local 'tree-get-descendants-list) + +;; mode entry function ;; + +(defun tree-build-tree (item buffer) + "Build inheritance tree for ITEM in BUFFER." + (tr-start-edition) + (tr-check-buffer buffer) + (or (tr-is-shown item) + ;;(if (tr-in-tree item) + (tr-find-and-show item);;) + (setq tr-data-list nil) + (if (tr-check-data-list item) + (tr-init-tree item) + (message "'%s' has neither ansestors nor descendants" item) + ) + ) + (tr-end-edition) + (and (tr-is-shown item) + (tr-goto-item) + (message nil)) + ) + +;; customisation functions for debug and mode demonstration ;; + +(defun tr-get-ansestor-fun (item) + (if (> (length item) 4) + nil + (if (string-match "\\([1-9]\\)0*$" item) + (replace-match "0" nil nil item 1))) + ) +(defun tr-has-descendants-fun (item) + (if (string-match "^[^5]+0+$" item) t) + ) +(defun tr-get-descendants-list-fun (item) + (if (string-match "^\\([^0]+\\)\\(0*\\)0$" item) + (let ((head (match-string 1 item)) + (zeros (match-string 2 item)) + (fun '(lambda (nb) (concat head nb zeros))) + ) + (mapcar fun '(1 2 3 4 5 6 7 8 9 )))) + ) + +;; internal part ;; + +(defconst tree-left-margin 2 + "Number of left margin columns" + ) +(defun tr-level-str () + (make-string tree-level-width ? ) + ) +(defun tr-left-mrgn-str () + (make-string tree-left-margin ? ) + ) +(defun tr-top-mrgn-str () + (make-string tree-top-margin ?\n) + ) +;; item seach in buffer +(defconst tr-item-regexp "\\([ |]+\\)[ +-] \\(%s\\) \\([ +-]\\)$") +(defun tr-find-item-re (item) (format tr-item-regexp item)) +(defun tr-cur-item-re () (format tr-item-regexp "[^\n]+")) +(defun tr-found-item () (match-string 2)) +(defun tr-cur-des-sign () (match-string 3)) +(defun tr-item-point () (1- (match-end 1))) +(defun tr-goto-item () (goto-char (+ 3 (tr-item-point)))) + +(defun tr-current-item () + (save-excursion + (beginning-of-line) + (if (looking-at (tr-cur-item-re)) + (tr-found-item)) + )) +(defun tr-is-shown (item) + (save-excursion + (beginning-of-line) + (if (or (re-search-backward (tr-find-item-re item) nil t) + (re-search-forward (tr-find-item-re item) nil t)) + (tr-item-point)) + )) +(defun tr-set-des-sign (sign item) + (save-excursion + (if (tr-is-shown item) + (replace-match sign nil nil nil 3))) + ) +(defun tr-more-items (&optional backward-p) + (save-excursion + (if backward-p + (re-search-backward (tr-cur-item-re) nil t) + (re-search-forward (tr-cur-item-re) nil t) + )) + ) +;; store data in internal list ;; +(defvar tr-data-list nil) +(make-variable-buffer-local 'tr-data-list) + +(defun tr-check-data-list (item) + (or (assoc item tr-data-list) + (let* ((item-data (list item + (funcall tree-get-ansestor item) + (funcall tree-has-descendants item) + ))) + (and (or (nth 1 item-data) + (nth 2 item-data)) + (if tree-keep-info + (setq tr-data-list (cons item-data tr-data-list)) + 'not-remember) + item-data + ) + ))) +(defun tr-get-ans (item) + (nth 1 (tr-check-data-list item)) + ) +(defun tr-get-des-list (item) + (let* ((data (tr-check-data-list item)) + (des-list (nth 2 data)) + ) + (if (listp des-list) + des-list + (setq des-list (funcall tree-get-descendants-list item)) + (setcdr data (list (nth 1 data) des-list)) + des-list) + )) + +;; buffer edition ;; + +(defun tr-start-edition () + (setq buffer-read-only nil) + ) +(defun tr-end-edition () + (setq buffer-read-only t) + ) + +(defun tr-insert-item (item as-root-p &rest args-to-insert) + (let* ((item-data (tr-check-data-list item)) + (des-list (nth 2 item-data)) + ) + (insert + (if as-root-p + (if (tr-get-ans item) "+" " ") + "-") + " " item " " + (if des-list + (tr-des-sign des-list) + " ") + ) + (if args-to-insert + (apply 'insert args-to-insert)) + )) +(defun tr-des-sign (des-list) + "Return descendants sign an item should have" + (if (not (listp des-list)) + "+" ;; has descendants but none was shown + (let ((all-p t)) + (while (and all-p des-list) + (setq all-p (tr-is-shown (car des-list))) + (setq des-list (cdr des-list)) + ) + (if all-p "-" "+")) + ) + ) +(defun tr-next-line (&optional backward-p) + (let ((col (current-column)) + (inhibit-point-motion-hooks t) + ) + (if (if backward-p + (re-search-backward "\n" nil t) + (re-search-forward "\n" nil t)) + (= col (move-to-column col))) + )) +(defun tr-goto-spring-line (item-line-point) + (goto-char item-line-point) + (beginning-of-line 2) + ) +(defun tr-spring-string (item-true-point) + (save-excursion + (goto-char item-true-point) + (let ((str (tr-line-before))) + (beginning-of-line 2) + (if (looking-at (concat str "|[ -]")) + (setq str (concat str "|")) + (setq str (concat str " ")) + ) + (concat str (tr-level-str) "|") + )) + ) +(defun tr-line-before (&optional point) + (buffer-substring (or point (point)) + (save-excursion (beginning-of-line) (point))) + ) +(defun tr-in-tree (item) + (assoc item tr-data-list) + ) +(defun tr-init-tree (item) +;; (setq tr-data-list nil) + (erase-buffer) + (insert (tr-top-mrgn-str) (tr-left-mrgn-str)) + (tr-insert-item item 'as-root "\n") + (or (tr-show-all-descendants item) + (let ((ans (tr-get-ans item))) + (if ans + (tr-show-ansestor item ans))) + ) + ) +(defun tr-find-and-show (item) + (let (branch pnt) + (if (setq branch (tr-find-shown-ans item)) + (while (nth 1 branch) + (setq pnt (tr-show-descendant (car branch) (nth 1 branch) pnt)) + (setq pnt (1- pnt)) + (setq branch (cdr branch)) + ) + (if (setq branch (tr-find-shown-des item)) + (while (nth 1 branch) + (tr-show-ansestor (car branch) (nth 1 branch)) + (setq branch (cdr branch)) + ) + )) + branch) + ) +(defun tr-find-shown-ans (item) + (let ((des item) + ;;(branch (list item)) + branch ans found-p) + (while (and (not found-p) + (setq ans (tr-get-ans des)) +;;; (setq ans (nth 1 (assoc des tr-data-list))) + ) + (setq found-p (tr-is-shown ans)) + (setq branch (cons des branch)) + (setq des ans) + ) + (if found-p + (cons ans branch)) + )) +(defun tr-show-ansestor (des ans &optional des-true-pnt) + (let* ((des-pnt (or des-true-pnt (tr-is-shown des))) + (spring-str (tr-spring-string des-pnt)) + ans-true-pnt) + (goto-char des-pnt) + (if (looking-at " \\([ +]\\) ") + (replace-match "-" nil nil nil 1)) + (move-to-column tree-left-margin) + (setq ans-true-pnt (1- (point))) + (tr-insert-item ans 'as-root "\n" spring-str "\n" spring-str) + (let ((str (concat (tr-level-str) " "))) + (while (tr-next-line) + (beginning-of-line) + (insert str) + )) + (tr-set-des-sign (tr-des-sign (tr-get-des-list ans)) ans) + ans-true-pnt) + ) +(defun tr-find-shown-des (item) + (message "Look for shown descendant of '%s'..." item) + (let ((des-list (nth 2 (assoc item tr-data-list))) + found-p branch des) + (while (and des-list (listp des-list) (not found-p)) + (setq des (car des-list) + des-list (cdr des-list)) + (if (tr-is-shown des) + (setq branch (list des item) + found-p t) + (if (setq branch (tr-find-shown-des des)) + (setq branch (append branch (list item)) + found-p t)) + )) + branch) + ) +(defun tr-show-descendant (ans des &optional ans-pnt) + "Return point where DES itself is inserted \(not it's true point)" + (let* ((ans-pnt (or ans-pnt (tr-is-shown ans))) + (spring-str (tr-spring-string ans-pnt)) + des-pnt) + (tr-goto-spring-line ans-pnt) + (if (looking-at spring-str) + (beginning-of-line 2) + (insert spring-str "\n" )) + (insert spring-str) + (setq des-pnt (point)) + (tr-insert-item des nil "\n") + (or (looking-at (concat spring-str "-")) + (looking-at "[ |]+$") + (insert (substring spring-str 0 (- tree-level-width)) "\n")) + (sit-for 0) + des-pnt) + ) +(defun tr-kill-line (&optional move-up) + "Kill a whole line" + (let ((col (current-column))) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line) (point))) + (if move-up (beginning-of-line 0)) + (move-to-column col)) + ) +(defun tr-hide-descendants (item-true-pnt) + (goto-char item-true-pnt) + (and (tr-current-item) + (not (string= " " (tr-cur-des-sign))) + (tr-set-des-sign "+" (tr-found-item))) + (let ((col (current-column))) + (if (tr-next-line) + (while (and (not (looking-at "|-")) + (= col (tr-kill-line))) + (sit-for 0) + ) + ) + )) +(defun tr-hide-item (item &optional item-true-pnt) + (let* ((pnt (or item-true-pnt (tr-is-shown item))) + col) + (tr-hide-descendants pnt) + (tr-set-des-sign "+" (tr-get-ans item)) + (goto-char pnt) + (setq col (current-column)) + (if (and (= col (tr-kill-line)) ;; kill item + (looking-at "|-")) + nil ;; more brothers beneeth + (tr-next-line 'backward) + (move-to-column col) + (if (looking-at "|-") + nil ;; upper brother + (tr-kill-line 'up) + (if (looking-at "|[ \n]") + ;; hide branch before brother's children + (while (looking-at "\\(|\\)[ \n]") + (replace-match " " nil nil nil 1) + (tr-next-line 'backward) + (move-to-column col) + ) + ;; lines between ansestors + (if (tr-current-item) + (let ((str (tr-line-before (tr-item-point)))) + (beginning-of-line 2) + (if (looking-at (concat str "|")) + (tr-kill-line)) + ))) + ))) + ) +(defun tr-hide-ansestor (item item-true-pnt des-sign) + (tr-goto-spring-line item-true-pnt) + (let* ((beg (point)) + (l-mrgn-str (tr-left-mrgn-str)) + des-str extra-len spring-str col) + (goto-char item-true-pnt) + (setq col (current-column)) + ;; look for descendants end + (while (and (tr-next-line) + (looking-at "[ |] +|")) + ) + ;; erase all but descendants + (beginning-of-line) + (setq des-str (buffer-substring beg (point))) + (erase-buffer) + ;; insert item and descendants + (insert (tr-top-mrgn-str) ) + (setq beg (point)) + (tr-insert-item item 'as-root "\n") + (setq spring-str (tr-spring-string beg)) + (setq beg (point)) + (insert des-str) + ;; left margin string before item + (goto-char beg) + (beginning-of-line 0) + (insert l-mrgn-str) + ;; cut off extra chars + (end-of-line 2) + (setq extra-len (- (point) beg (length spring-str) 1)) + (beginning-of-line 0) + (if (< 0 extra-len) + (while (and (tr-next-line) + (< (+ (point) extra-len) (point-max))) + (delete-region (point) (+ (point) extra-len)) + (insert l-mrgn-str) + (beginning-of-line) + )) + (tr-set-des-sign des-sign item) + ) + ) +(defun tr-show-all-descendants (item &optional item-true-pnt) + ;; return spring-string + (let* ((des-list (tr-get-des-list item)) + des-pnt spring-str) + (and des-list + ;;(message "Show %s descendants..." (length des-list)) + (tr-set-des-sign "-" item)) + (while des-list + (if (tr-is-shown (car des-list)) + nil + (if spring-str + (tr-insert-item (car des-list) nil "\n" spring-str) + (goto-char (tr-show-descendant item (car des-list))) + (setq spring-str (tr-line-before)) + )) + (sit-for 0) + (setq des-list (cdr des-list)) + ) + spring-str) + ) +(defun tr-check-buffer (buffer) + (or (buffer-live-p buffer) + (setq buffer (get-buffer-create "*tree*"))) + (let ((win (get-buffer-window buffer))) + (if win + (select-window win) + (pop-to-buffer buffer))) + (or tr-data-list + (tree-mode)) + ) +(defvar tree-mode-map nil + "Keymap for tree-mode" + ) +(or tree-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [C-return] 'tree-show-ansestors) + (define-key map [M-up] 'tree-previous-item-same-level) + (define-key map [M-down] 'tree-next-item-same-level) + (define-key map [M-prior] 'tree-level-up) + (define-key map [M-next] 'tree-level-down) + (define-key map [up] 'tree-previous-item) + (define-key map [down] 'tree-next-item) + (define-key map "\C-z" 'tree-undo) + (define-key map [C-delete] 'tree-hide-current-item) + (define-key map [M-delete] 'tree-hide-ansestors) + (define-key map [M-insert] 'tree-show-ansestors) + (define-key map [delete] 'tree-hide-descendants) + (define-key map [insert] 'tree-show-descendants) + + (setq tree-mode-map map) + ) + ) +;; (use-local-map tree-mode-map) +(defun tree-mode () + "Mode for presentation and exploration of data having tree structure. +Mode entrance function is 'tree-build-tree. To try 'tree-mode evaluate +\(tree-build-tree \"1000\" nil). +To use 'tree-mode for your own data, bind variables 'tree-get-ansestor, +'tree-has-descendants and 'tree-get-descendants-list to your functions +before calling 'tree-build-tree. + +Keybindings: +\\{tree-mode-map}" + + (run-hooks 'tree-mode-hooks) + + (make-local-variable 'tree-level-width) + (make-local-variable 'tree-keep-info) + (make-local-variable 'tree-top-margin) + + (or tree-get-descendants-list + (progn (message "Tree mode demonstration") + (setq tree-get-descendants-list 'tr-get-descendants-list-fun + tree-has-descendants 'tr-has-descendants-fun + tree-get-ansestor 'tr-get-ansestor-fun) + )) + (if (member major-mode '(fundamental-mode nil)) + (setq major-mode 'tree-mode)) + (if (string= "Fundamental" mode-name) + (setq mode-name "tree")) + (use-local-map tree-mode-map) + ) + + +;; interactive functions ;; + +(defun tree-show-descendants (arg &optional item) + "Show up to ARG-th level descendants of current item" + (interactive "p") + (if (> arg 0) + (let* ((ans (or item (tr-current-item))) + (des-list (if ans (tr-get-des-list ans))) + (len (length des-list)) + (msg (and (null item) des-list + (format "Look for not shown of %d descendants " len))) + (nb 1) + des) + (save-excursion + (tr-start-edition) + (while des-list + (and msg + (eap-progress-indicator nb len msg)) + (setq des (car des-list) + des-list (cdr des-list) + nb (1+ nb)) + (or (tr-is-shown des) + (tr-show-descendant ans des)) + (if (= arg 2) + (tr-show-all-descendants des) + (tree-show-descendants (1- arg) des) + ) + ) + (if des + (tr-set-des-sign "-" ans)) + (if (interactive-p) (tr-end-edition)) + ) + (and (null item) + des + (message "Ok") + ) + )) + ) +(defun tree-show-ansestors (arg &optional item item-true-pnt) + "Show up to ARG-th level ansestors of current item" + (interactive "p") + (if (> arg 0) + (let* ((des (or item (tr-current-item))) + (des-pnt (if item item-true-pnt (tr-item-point))) + (ans (if des (tr-get-ans des))) + ans-pnt) + (if ans + (save-excursion + (tr-start-edition) + (setq ans-pnt + (or (tr-is-shown ans) + (tr-show-ansestor des ans des-pnt))) + (tree-show-ansestors (1- arg) ans ans-pnt) + (tr-end-edition) + )) + (and (null item) + ans + (message "Ok")) + )) + ) +(defun tree-hide-descendants () + "Hide descendants of current item" + (interactive) + (if (null (tr-current-item)) + nil + (let ((item (tr-found-item))) + (tr-start-edition) + (tr-hide-descendants (tr-item-point)) + (tr-end-edition) + (if (tr-is-shown item) + (tr-goto-item)) + )) + ) +(defun tree-hide-ansestors () + "Hide ansestors of current item" + (interactive) + (if (null (tr-current-item)) + nil + (let* ((item (tr-found-item)) + (des-sign (tr-cur-des-sign)) + (pnt (tr-item-point)) + ) + (tr-start-edition) + (tr-hide-ansestor item pnt des-sign) + (tr-end-edition) + (if (tr-is-shown item) + (tr-goto-item)) + )) + ) +(defun tree-hide-current-item () + "Hide currrent item and it's descendants" + (interactive) + (tr-start-edition) + (if (tr-current-item) + (tr-hide-item (tr-found-item) (tr-item-point))) + (tr-end-edition) + (while (and (not (tr-current-item)) + (tr-next-line 'back))) + (if (tr-current-item) + (tr-goto-item)) + ) +(defun tree-previous-item () + "Move up to previous item" + (interactive) + (setq mark-active nil) + (tr-next-line 'backward) + (while (and (null (tr-current-item)) + (tr-more-items 'backward)) + (tr-next-line 'backward)) + (if (tr-current-item) + (tr-goto-item)) + ) +(defun tree-next-item () + "Move down to next item" + (interactive) + (setq mark-active nil) + (tr-next-line) + (while (and (null (tr-current-item)) + (tr-more-items)) + (tr-next-line)) + (if (tr-current-item) + (tr-goto-item)) + ) +(defun tree-level-up () + "Move to an upper level item" + (interactive) + (tr-next-item-check-level 'back '>) + ) +(defun tree-level-down () + "Move to next level item" + (interactive) + (tr-next-item-check-level (not 'back) '<) + ) +(defun tree-previous-item-same-level () + "Move up to previous item of the same level" + (interactive) + (tr-next-item-check-level 'back '=) + ) +(defun tree-next-item-same-level () + "Move down to next item of the same level" + (interactive) + (tr-next-item-check-level (not 'back) '=) + ) +(defun tr-next-item-check-level (backward-p check-level-fun) + "CHECK-LEVEL-FUN compares current level \(column) to target one" + (setq mark-active nil) + (if (and (null (tr-current-item)) + (not (if backward-p (tree-previous-item) (tree-next-item)))) + nil + (let ((col (progn (tr-goto-item) (current-column))) + (pnt (point)) + ) + (save-excursion + (if backward-p (tree-previous-item) (tree-next-item)) + (while (and (not (funcall check-level-fun col (current-column))) + (tr-more-items backward-p)) + (if backward-p (tree-previous-item) (tree-next-item)) + ) + (if (funcall check-level-fun col (current-column)) + (setq pnt (point)) + (message "Required level item not found")) + ) + (goto-char pnt) + )) + ) +(defun tree-undo (arg) + "Undo some previous changes" + (interactive "p") + (let ((item (tr-current-item))) + (tr-start-edition) + (undo arg) + (tr-end-edition) + ;; move to last current item + (if (and item (tr-is-shown item)) + (tr-goto-item) + ;; or any shown + (or (tree-previous-item) + (tree-next-item)) + (tr-goto-item)) + ) + ) + +(provide 'tree) diff --git a/src/WOKsite/public_el/type-search.el b/src/WOKsite/public_el/type-search.el new file mode 100644 index 0000000..44a277e --- /dev/null +++ b/src/WOKsite/public_el/type-search.el @@ -0,0 +1,520 @@ +;;; type-search.el --- define a type of a matter at point in source file + +;;;Author : Edward AGAPOV +;;;History : Thu Oct 11 2001 Edward AGAPOV Creation + +(require 'method-search) +(require 'class-info) + +(defun eap-current-type () + "Return type found at point in c++ or cdl file, +or type of c++ object (local variable or field) at point." + (or (eap-class-in-cdl) + (if (equal 'c++-mode (eap-file-mode)) + (eap-type-of-object (eap-current-word))) + (eap-current-word) + ) + ) +(defvar eap-type-is-handle nil + "stringp means 'not defined'. Is set by type search." + ) +(defvar eap-type-scope-description nil + "Is set by type search" + ) +(defvar eap-type-modifier-string nil + "Is set by type search" + ) +(defun eap-type-modifier (&optional raw) + "Return modificator string for type found by 'eap-current-type +without spaces and other stuff. Result may be nil. +Modificators are *,&,[], etc" + (if eap-type-modifier-string + (eap-simplify-string eap-type-modifier-string '("[ \t\n]+"))) + ) +(defun eap-type-handle-p (type-pos) + "Check if last found object type is handle" + (if (not (stringp eap-type-is-handle)) + eap-type-is-handle + (if (null (nth 1 type-pos)) ;; type was not found or file-pos is null + nil + ;; type surely is a field found in cdl + (let* ((type (car type-pos)) + (file (car (nth 1 type-pos))) + (hxx-file (eap-find-file-with-ext file "hxx")) + (pnt (cdr (nth 1 type-pos))) + (buf (if hxx-file (eap-find-file-noselect hxx-file))) + ) + (if (or (not (string-match "[.]cdl" file)) + (null buf)) + ;; strange but nevertheless + (prog1 (eap-find-file-in (concat "Handle_" type ".hxx") "inc") + (if buf (kill-buffer buf))) + ;; find field in hxx + (set-buffer buf) + (goto-char (point-max)) + (prog1 (re-search-backward (concat "^ *Handle *[_(]" type "[) ]" ) nil t) + (kill-buffer buf)) + ))) + )) +(defun eap-get-type-descriptors () + "Return list of 'eap-type-is-handle, 'eap-type-scope-description and +'eap-type-modifier-string" + (list eap-type-is-handle eap-type-scope-description eap-type-modifier-string) + ) +(defun eap-set-type-descriptors (descr-list) + "set 'eap-type-is-handle, 'eap-type-scope-description and +'eap-type-modifier-string from list returned by 'eap-get-type-descriptors" + (setq eap-type-is-handle (nth 0 descr-list) + eap-type-scope-description (nth 1 descr-list) + eap-type-modifier-string (nth 2 descr-list)) + ) +(defun eap-type-of-object (obj &optional pos) + "If POS returns list \(\ \(\ . \\)\)" + (save-excursion + (setq eap-type-is-handle "not defined") + (setq eap-type-scope-description nil) + (let* ((not-gen-param t) + (type (or (if (string= "this" obj) + (let ((cls (eap-class-name))) + (if pos (setq cls (list cls (cons buffer-file-name (point))))) + (setq eap-type-scope-description "this class object pointer") + cls)) + (eap-type-of-object-in-buffer obj pos) + (eap-type-of-field obj pos) + (setq not-gen-param nil) + (eap-find-generic-parameter-type obj pos))) + (type-name (if pos (car type) type)) + ) + (if type + (if (and (string-match "[.][gl]xx" buffer-file-name) + (not (string-match "_" type-name))) + ;; look for real type name of generic parameter + (let ((param-type-name (eap-find-generic-parameter-type type-name))) + (and param-type-name + (setq type-name param-type-name) + (if pos + (setcar type type-name) + (setq type type-name)) + (setq not-gen-param nil) + ) + ) + ;; look for real type by typedef (pointer case) + (let* (file buf) + (and (setq file (eap-find-file-with-ext type-name "hxx" 'any)) + (setq buf (set-buffer (eap-find-file-noselect file))) + (re-search-forward + (format "^[^/]*typedef \\([^ ]+\\)[*] %s;" type-name) nil t) + (setq type-name (match-string 1)) + (if pos + (setcar type type-name) + (setq type type-name)) + ) + (if buf (kill-buffer buf)) + ))) + (if (string-match "^Handle_" (or type-name "")) + (let ((name (substring type-name (match-end 0)))) + (setq eap-type-is-handle t) + (if pos + (setcar type name) + (setq type name)) + )) + (or (null type) + not-gen-param + (setq eap-type-scope-description + (if eap-type-scope-description + (concat eap-type-scope-description ", generic parameter") + "generic parameter"))) + type)) + ) + +;; regexp for obj standing after other obj of the same type +(defun eap-obj-sch-re2 (&optional obj) + (concat ",\\([\t\n *]*\\)\\(" (or obj "[_a-zA-Z0-9]+") "\\)[\t\n ]*\\([[,=(;]\\)" )) +;; regexp for obj standing next to it's type +(defun eap-obj-sch-re1 (&optional obj) + (concat "[ \t\n{},;(]" + "\\(\\(static\\|const\\|extern\\|Standard_EXPORT\\|Standard_IMPORT\\)[\t\n ]+\\)?" + "\\(Handle[\t\n ]*[(_] *\\)?" + "\\([_a-zA-Z0-9]+\\)" ;; type name + "\\([][*&) \t\n]+\\)" ;; type modifs (*& etc) + "\\(" (or obj "[_a-zA-Z0-9]+") "\\)[\t\n ]*\\([[,=();]\\)" )) +(defun eap-obj-sch-obj (&optional re2-p) (eap-match-string (if re2-p 2 6))) +(defun eap-obj-sch-obj-pnt (&optional re2-p) (match-end (if re2-p 2 6))) +(defun eap-obj-sch-handle-p () (eap-match-string 3)) ;; for search-forward re1 only +(defun eap-obj-sch-type () (eap-match-string 4)) ;; for re1 only +(defun eap-obj-sch-type-modifs (&optional re2-p) + (concat + (eap-match-string (if re2-p 1 5)) + (eap-simplify-string (eap-match-string (if re2-p 3 7)) '("[^[]")) + )) + +(defun eap-statement-beg (&optional decl-beg) + "Return position of current statement beginning. +Current point should not be in comment, so it is supposed that 'eap-quit-comment or +'eap-in-comment has been called before and it returned nil. +DECL-BEG means that beginning of currunt variable declaration is needed, which +may happen to be a function argument" + (save-excursion + ;; end of prev statment + (if (not decl-beg) + (skip-chars-backward "^{}#;") + (and (looking-at "(") + (if (string-match "^\\(Handle\\|if\\)$" (current-word)) + (forward-char -3) + ;; arg list first paren? + (let ((paren-pnt (point))) + (skip-chars-backward " \t\n") + (forward-char -1) + (and (looking-at "[a-zA-Z0-9]") + (skip-chars-backward "_a-zA-Z0-9") + (skip-chars-backward " \t\n") + (or (bobp) (forward-char -1) t) + (looking-at "[&*:)a-zA-Z0-9]") + (goto-char paren-pnt)) ;; keep point if look like arg list first paren + ))) + (or (looking-at "[{}#,(;]") + (skip-chars-backward "^{}#,(;"))) + ;; preprocessor instruction? + (if (= ?# (char-after (1- (point)))) + (end-of-line)) + ;; skip comment and white spaces before declaration + (if (< (point) (cdr eap-next-comment-ends)) ;save time on 'eap-quit-comment + (eap-quit-comment nil 'skip-spaces) + (skip-chars-forward " \t\n")) + (if (looking-at "[a-zA-Z0-9]") + (point) (1+ (point))) + )) +(defun eap-obj-sch (obj &optional re2-p boundary) + "Return alist \(type object-point declaration-beginning)" + (let* ((re (if re2-p (eap-obj-sch-re2 obj) (eap-obj-sch-re1 obj))) + (forbiden-type-re "^\\(return\\|delete\\|else\\|const\\|Handle\\|void\\|[0-9]+\\)$") + (case-fold-search nil) ;; Case is significant for c++ obj names + type obj-pnt stmt-beg handle-p modif + ) + (save-excursion + (while (and (null type) + (re-search-backward re boundary t)) + (or (eap-quit-comment 'backward) + (setq obj-pnt (eap-obj-sch-obj-pnt re2-p) + eap-type-modifier-string (eap-obj-sch-type-modifs re2-p) + type nil) + (and ;;(not re2-p) check long modifs + (setq modif (eap-type-modifier)) + (> (length modif) 1) + (not (string-match "^)&\\|[[]]$" modif))) ;; <- allowed long modifs + (save-excursion + ;; statement beginning + (setq stmt-beg (eap-statement-beg (not re2-p))) + (goto-char (1- stmt-beg)) + ;; look at declaration? + (and (looking-at (if re2-p (eap-obj-sch-re1) re)) + (setq handle-p (eap-obj-sch-handle-p) + type (eap-obj-sch-type)) + ;; wrong type name? + (or (string-match forbiden-type-re type) + (if re2-p + ;; arg in function call? + (let ((before-str (buffer-substring stmt-beg obj-pnt))) + (> (eap-count-symbols-in-string "(" before-str) + (eap-count-symbols-in-string ")" before-str)) + ) + ;; multiplication or pointer declaration? + (and (string= "*" modif) + ;; only arg decl is doubtful + (or (looking-at ",") + (save-excursion + (skip-chars-backward "^,{};") + (if (< 1 (point)) ;; not skipped up to buffer beginning + (= ?, (char-after (1- (point))))))) + ;; function call or declaration? + (save-excursion + (skip-chars-forward "^{;") + (looking-at ";")) + ) + ) + ) + (setq type nil) ;; not declaration encountered + ) + )))) + (if (null type) + nil + (setq eap-type-is-handle (stringp handle-p)) + (list type obj-pnt stmt-beg))) + ) +(defun eap-static-obj-p (obj-point) + "Check that OBJ-POINT is not inside method definition" + (save-excursion + (goto-char obj-point) + (if (not (re-search-forward "^[^/\n]*{" nil t)) + 'static + (let ((eap-method-search-boundaries (cons (point) (point)))) + (goto-char obj-point) + (and (eap-method-fullstring nil nil 'save 'c++-mode) + (not (re-search-backward "^[^/\n]*}" obj-point t)) + ) + ))) + ) +(defun eap-type-of-object-in-buffer (obj &optional pos boundary) + "Find type of OBJ in current c++ buffer. +If POS, returns list \(\ \(\ . \\)\). +BOUNDARY is a limit for backward search" + (or (stringp obj) + (error "OBJECT IS NOT A STRING")) + (let ((bnd boundary) + (cur-pnt (point)) + type-pos type-pos-1 type-pos-2 meth-pos descr-1 descr-2 + eap-method-search-boundaries + ) + (or boundary + (re-search-forward "[{});]" nil t) ;; may be we are on declaration + ) + ;; search for re1 + (and (setq type-pos-1 (eap-obj-sch obj (not 're2) bnd)) + (setq type-pos type-pos-1) + (null bnd) + ;; must be in current method or static + (setq eap-method-search-boundaries (cons (nth 2 type-pos)(nth 2 type-pos))) + (setq meth-pos (eap-method-fullstring 'backwards 'pos 'save-pos)) + ;; found in other method or is static + (setq bnd (nthcdr 2 meth-pos)) ;; for re2 search + (setq type-pos nil) + ) + (setq eap-type-scope-description "local variable") + (setq descr-1 (eap-get-type-descriptors)) + (if type-pos + ;; are we inside method args? + (save-excursion + (setq eap-method-search-boundaries (cons (nth 1 type-pos) (nth 1 type-pos) )) + (goto-char (nth 2 type-pos)) + (skip-chars-backward "^{};") + (setq meth-pos (eap-method-fullstring (not 'backwards) 'pos 'save-pos)) + (and meth-pos + (< (nth 1 type-pos) (nthcdr 2 meth-pos)) + (setq eap-type-scope-description "function argument")) + )) + ;; search for re2 + (and (null type-pos) + (setq type-pos-2 (eap-obj-sch obj 're2 bnd)) + (setq type-pos type-pos-2) + (null bnd) + ;; must be in current method or static + (setq eap-method-search-boundaries (cons (nth 2 type-pos)(nth 2 type-pos))) + (setq meth-pos (eap-method-fullstring 'backwards 'pos 'save-pos)) + ;; found in other method or is static + (setq type-pos nil) + ) + (setq descr-2 (eap-get-type-descriptors)) + (or boundary + type-pos + ;; found is static? + (and (or type-pos-1 type-pos-2) + (eap-static-obj-p (nth 1 (or type-pos-1 type-pos-2))) + (save-excursion + (eap-set-type-descriptors (if type-pos-1 descr-1 descr-2)) + (goto-char (nth 2 (or type-pos-1 type-pos-2))) + (if (looking-at "static\\>") + (setq eap-type-scope-description "static variable") + (setq eap-type-scope-description "global variable")) + (setq type-pos (or type-pos-1 type-pos-2)))) + (save-excursion + ;; look for static or global before the first method definition + (setq type-pos-1 nil type-pos-2 nil) + (goto-char (point-min)) + (re-search-forward "^[^/\n]*{" nil t) + (and (search-backward ";" nil t) + (setq type-pos + (or (setq type-pos-1 (eap-obj-sch obj (not 're2))) + (setq type-pos-2 (eap-obj-sch obj 're2)))) + (goto-char (nth 2 type-pos)) + (if (looking-at "static\\>") + (setq eap-type-scope-description "static variable") + (setq eap-type-scope-description "global variable")) + ;; check that we are not in method declaration + (if type-pos-1 + (while (not (bobp)) + (eap-no-comment (skip-chars-backward "^(#;")) + (forward-char -1) + (if (or (bobp) (looking-at "[;#]")) + (goto-char (point-min)) ;; ok -> quit + (skip-syntax-backward "^w") + (skip-syntax-backward "w_") + (or (looking-at "Handle") + (setq type-pos nil) + (goto-char (point-min)) ;; ko -> quit + ) + )))) + ;; look for static through the whole buffer + (goto-char (point-min)) + (let ((re (format "^[ \t]*static[ \t]+[^{};]*%s[\t\n ]*[[,=();]" obj))) + (while (and (null type-pos) + (re-search-forward re cur-pnt t)) + (setq bnd (match-beginning 0)) + (if (setq type-pos (or (eap-obj-sch obj (not 're2) bnd) + (eap-obj-sch obj 're2 bnd))) + (if (eap-static-obj-p (nth 1 type-pos)) + (setq eap-type-scope-description "static variable") + (setq type-pos nil))) + )) + type-pos + ) + ;; defined symbol + (save-excursion + (if (re-search-backward (format "^[/ \t\n]*# *define +%s +\\([^\n]+\\)" obj) nil t) + (setq type-pos (list (match-string 1) (match-beginning 1)) + eap-type-scope-description "macro")) + ) + ) + (if (null type-pos) + (setq eap-type-is-handle "not defined" + eap-type-scope-description nil) + (if pos + (setq type-pos (list (car type-pos) (cons buffer-file-name (nth 1 type-pos)))) + (setq type-pos (car type-pos)))) + type-pos) + ) + +(defun eap-type-of-field (field &optional pos) + "If POS returns list \(\ \(\ . \\)\)" + (eap-walk-over-inherited + '(lambda () + (let ((type + (if (string-match "[.]cdl" buffer-file-name) + (eap-type-of-field-in-cdl field pos) + (eap-type-of-field-in-hxx field pos) + ))) + (if type + (setq eap-type-scope-description (format "field of %s" (eap-class-name)))) + type) + ) + (or (eap-find-source buffer-file-name t) " ") nil t) + ) +(defun eap-type-of-field-in-cdl (field &optional pos) + "Tries to find type of FIELD in current cdl buffer. +If POS returns list \(\ \(\ . \\)\)" + (save-excursion + ;; field ex: myValue1, myValue2 : Real [4,2]; + (let* ((re (concat "^\\([^-\n]*[ \t,]\\)?\\(" field + "\\)\\s *\\(,[^:]+\\)?:\\s *\\(\\w+\\)" + "\\(\\s +from\\s +\\(\\w+\\)\\)?" + "\\(\\s *\\[\\)?")) ;; [] modif + case-fold-search ;; do not ignore case + type) + (goto-char (point-max)) + (re-search-backward "^[^-]*fields\\>" nil t) + (if (not (re-search-forward re nil t)) + nil + (setq eap-type-modifier-string (match-string 7)) + (let* ((cl (match-string 4)) + (pack (match-string 6)) + (pt (match-beginning 2)) + ) + (if pack + (setq type (concat pack "_" cl)) + (setq type + (or (eap-find-pack-for-class cl) cl))) + (and type + pos + (setq type (list type (cons buffer-file-name pt))) + ) + type) + ))) + ) +(defun eap-type-of-field-in-hxx (field &optional pos) + "Tries to find type of FIELD in current hxx buffer. +If POS returns list \(\ \(\ . \\)\)" + (let* ((re (format + "^\\s *\\([()_a-zA-Z0-9]+\\)\\([ *\t\n]+\\)%s\\s *\\([][0-9]+ *\\)?;" field)) + case-fold-search ;; do not ignore case + type) + (goto-char 1) + (if (not (re-search-forward re nil t)) + nil + (setq type (list (match-string 1) + (cons buffer-file-name (match-beginning 1)))) + (setq eap-type-modifier-string + (concat (match-string 2) + (eap-simplify-string (or (match-string 3) "") '("[0-9]+")))) + (if (setq eap-type-is-handle (string-match "Handle[ \t\n]*(" (car type))) + (setcar type (substring (car type) (match-end 0) -1))) + (if pos type (car type)) + )) + ) + +(defun eap-class-in-cdl (&optional cdl-type) + "Return class name found at point in cdl buffer" + (or (eap-cdl-class nil (not cdl-type)) + (eap-cdl-class-decl (not cdl-type)) + ) + ) +(defun eap-cdl-class (&optional ends cpp-type) + "returns string with cdl class description like +found near the point. If ENDS is not nil returns list: +\( \(START . END\)\) where START and END are boundary +points of retstring in buffer" + ;;(message "look for CDL") + (let ((notfound t)) + (save-excursion + (or (eobp) (forward-char 1)) + (forward-word -1) + (if (looking-at "from ") + (setq notfound nil) + (forward-word -1) + (if (looking-at "from ") + (setq notfound nil) + (forward-word 3) + (forward-word -1) + (if (looking-at "from ") + (setq notfound nil)))) + (forward-word -1) + (if (or notfound + (not (looking-at "\\(\\w+\\)[ \t\n]+from[ \t\n]+\\(\\w+\\)"))) + nil + (let* ((cls (match-string 1)) + (pack (match-string 2)) + (pos (cons (match-beginning 0) (match-end 0))) + (ret (if cpp-type + (concat pack "_" cls) + (concat cls " from " pack))) + ) + (if ends (cons ret pos) ret))) + )) + ) + +(defun eap-cdl-class-decl (&optional cpp-type) + "Return found as around point" + (let ((count 3) + (re (eap-look-at-cls-re)) + found-p) + (save-excursion + (or (eobp) (forward-char 1)) + (while (and (< 0 count) + (not (setq found-p (looking-at re))) + ) + (if (looking-at "instantiates[ \t\n]+") + (re-search-backward "class[ \t\n]" nil t) + (backward-word 1)) + (setq count (1- count)) + ) + (if found-p + (let ((cls (eap-cls-sch-cl)) + (pack (eap-cls-sch-pack)) + (gen-cl (eap-cls-sch-gen-cl)) + (gen-pack (eap-cls-sch-gen-pack)) + ) + (or pack + (setq pack (eap-get-package-name buffer-file-name))) + (if gen-cl + (eap-update-instantiation-list + (list (concat pack "_" cls) + (concat gen-pack (if gen-pack "_") gen-cl) + (eap-class-name buffer-file-name) + gen-pack)) + ) + (if cpp-type + (concat pack "_" cls) + (concat cls " from " pack)) + )) + )) + ) + +(provide 'type-search) diff --git a/src/WOKsite/public_el/wok-view.el b/src/WOKsite/public_el/wok-view.el new file mode 100644 index 0000000..5f14ed3 --- /dev/null +++ b/src/WOKsite/public_el/wok-view.el @@ -0,0 +1,70 @@ +;; Default view for WOK in Emacs + +;; Load color settings +;;(set-default-font "Courier New:14") +;(set-default-font "DejaVu Sans Mono Bold:14") +(set-screen-width 120) +(set-screen-height 55) +;;(set-background-color "MidnightBlue") +(set-background-color "White") +(set-foreground-color "Black") +(load "theme-kgv") + +;; no splash screen +(setq inhibit-splash-screen t) +;; no toolbar +;;(if (fboundp 'tool-bar-mode) (tool-bar-mode -1)) +;;no menubar +;;(menu-bar-mode -1) +;; no scroll bar +;;(scroll-bar-mode -1) + +(if (string-match "Emacs 22." (emacs-version)) + (progn + ;; NT-emacs assumes a Windows command shell. + (setq process-coding-system-alist '(("bash" . undecided-unix))) + (setq shell-file-name "bash") + (setenv "SHELL" shell-file-name) + (setq explicit-shell-file-name shell-file-name) + ;; + ;; This removes unsightly ^M characters that would otherwise + ;; appear in the output of java applications. + ;; + (add-hook 'comint-output-filter-functions + 'comint-strip-ctrl-m) + ; in order to find header file like C-x C-f RET + (partial-completion-mode t) + ; C++ mode indentation style + (c-add-style "OCC" '("gnu" (c-offsets-alist (substatement-open . 0)))) + )) + +(load "my_csf") + +(custom-set-variables + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(c-offsets-alist (quote ((substatement-open . 0)))) + '(cvs-auto-remove-directories (quote empty)) + '(cvs-auto-remove-handled nil) + '(font-lock-maximum-decoration (quote ((t . 2) (sgml-mode . 3)))) + '(font-lock-maximum-size (quote ((t . 20000000))))) +(custom-set-faces + ;; custom-set-faces was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(cvs-handled ((((class color) (background light)) (:foreground "pink3")))) + '(cvs-msg ((t (:foreground "magenta4" :slant italic)))) + '(cvs-need-action ((((class color) (background light)) (:foreground "orange3")))) + '(font-lock-builtin-face ((((class color) (background light)) (:foreground "CadetBlue4")))) + '(font-lock-string-face ((((class color) (background light)) (:foreground "RosyBrown4"))))) + +(put 'upcase-region 'disabled nil) +(put 'downcase-region 'disabled nil) + +;; ABV settings +(load "abv-keys.el") +(load "eap-pc-mode.el") +(eap-pc-mode-key) diff --git a/src/WOKsite/wok_emacs.bat b/src/WOKsite/wok_emacs.bat new file mode 100644 index 0000000..840bc98 --- /dev/null +++ b/src/WOKsite/wok_emacs.bat @@ -0,0 +1,11 @@ +@echo off + +rem This file setup WOK environment (calls 'wok_env.bat' script) +rem and launches the Emacs bound to WOK. +rem Press Alt+x in emacs and enter 'woksh' to launch the WOK shell. + +call "%~dp0wok_env.bat" +set "aPathBack=%CD%" +cd "%WOK_ROOTADMDIR%" +call "%WOKHOME%\3rdparty\win32\Emacs\bin\runemacs.exe" -fs +cd "%aPathBack%" diff --git a/src/WOKsite/wok_emacs.sh b/src/WOKsite/wok_emacs.sh new file mode 100644 index 0000000..e45396f --- /dev/null +++ b/src/WOKsite/wok_emacs.sh @@ -0,0 +1,13 @@ +#!/bin/bash + +# This file setup WOK environment (calls 'wok_env.sh' script) +# and launches the Emacs bound to WOK. +# Press Alt+x in emacs and enter 'woksh' to launch the WOK shell. + +# go to the script directory +aScriptPath=${BASH_SOURCE%/*}; if [ -d "${aScriptPath}" ]; then cd "$aScriptPath"; fi; aScriptPath="$PWD"; + +source "${aScriptPath}/wok_env.sh" + +cd "$WOK_ROOTADMDIR" +emacs -- 2.39.5