├── .gitignore ├── .vscode └── tasks.json ├── CommandLine ├── CommandLineConstants.pas ├── CommandLineReturnCode.pas ├── Lazarus │ ├── JCF.lpr │ └── jcf.lpi ├── StatusMessageReceiver.pas └── jcf.dof ├── Contributions └── StyleEditor │ ├── JCFStyle.bdsproj │ ├── JCFStyle.cfg │ ├── JCFStyle.res │ └── Readme.txt ├── IdePlugin ├── JcfIdeMain.pas ├── JcfIdeRegister.pas └── lazarus │ ├── Makefile │ ├── Makefile.compiled │ ├── Makefile.fpc │ ├── jcfidelazarus.lpk │ ├── jcfidelazarus.pas │ ├── jcfidemain.pas │ ├── jcfideregister.pas │ ├── jcfsettings.res │ └── jcfuiconsts.pas ├── Include └── JcfGlobal.inc ├── JCF.ico ├── JCFAllD11.bpg ├── JCFAllD12.bpg ├── JCFSettings.cfg ├── JcfGui ├── fMain.dfm ├── fMain.pas └── jcfGui.dof ├── JcfVersionConsts.pas ├── LICENSE ├── Notepad ├── frmJcfNotepad.dfm └── frmJcfNotepad.pas ├── Output ├── Lazarus │ ├── README.md │ ├── jcf-linux-64 │ ├── jcf-linux.zip │ ├── jcf-osx-64 │ ├── jcf-osx.zip │ ├── jcf-win-32.exe │ ├── jcf-win-64.exe │ ├── jcf-win.zip │ └── jcf.xml └── jcf.xml ├── Parse ├── AsmKeywords.pas ├── BuildParseTree.pas ├── BuildTokenList.pas ├── ParseError.pas ├── ParseTreeNode.pas ├── ParseTreeNodeType.pas ├── PreProcessor │ ├── PreProcessorExpressionParser.pas │ ├── PreProcessorExpressionTokenise.pas │ ├── PreProcessorExpressionTokens.pas │ ├── PreProcessorParseTree.pas │ └── backup │ │ └── PreProcessorParseTree.pas ├── SourceToken.pas ├── SourceTokenList.pas ├── TokenUtils.pas ├── Tokens.pas └── UI │ ├── backup │ └── fShowParseTree.pas │ ├── fShowParseTree.dfm │ ├── fShowParseTree.lfm │ └── fShowParseTree.pas ├── Process ├── Align │ ├── AlignAssign.pas │ ├── AlignBase.pas │ ├── AlignComment.pas │ ├── AlignConst.pas │ ├── AlignField.pas │ ├── AlignTypedef.pas │ └── AlignVars.pas ├── AllProcesses.pas ├── BaseVisitor.pas ├── Capitalisation │ ├── Capitalisation.pas │ ├── IdentifierCaps.pas │ ├── SpecificWordCaps.pas │ └── UnitNameCaps.pas ├── FormatFlags.pas ├── Indent │ ├── IndentAsmParam.pas │ └── Indenter.pas ├── Info │ └── BasicStats.pas ├── Nesting.pas ├── Obfuscate │ ├── FixCase.pas │ ├── RebreakLines.pas │ ├── ReduceWhiteSpace.pas │ ├── RemoveBlankLine.pas │ ├── RemoveComment.pas │ ├── RemoveConsecutiveWhiteSpace.pas │ ├── RemoveReturn.pas │ └── RemoveUnneededWhiteSpace.pas ├── Onceoffs │ ├── GlobalInclude.pas │ └── MozComment.pas ├── RemoveEmptyComment.pas ├── Returns │ ├── BlockStyles.pas │ ├── LongLineBreaker.pas │ ├── NoReturnAfter.pas │ ├── NoReturnBefore.pas │ ├── PropertyOnOneLine.pas │ ├── RemoveBlankLinesAfterProcHeader.pas │ ├── RemoveBlankLinesInVars.pas │ ├── RemoveConsecutiveReturns.pas │ ├── RemoveReturnsAfter.pas │ ├── RemoveReturnsAfterBegin.pas │ ├── RemoveReturnsBeforeEnd.pas │ ├── ReturnAfter.pas │ ├── ReturnBefore.pas │ ├── ReturnChars.pas │ └── ReturnsAfterFinalEnd.pas ├── Spacing │ ├── MaxSpaces.pas │ ├── MoveSpaceToBeforeColon.pas │ ├── NoSpaceAfter.pas │ ├── NoSpaceBefore.pas │ ├── RemoveSpaceAtLineEnd.pas │ ├── SingleSpaceAfter.pas │ ├── SingleSpaceBefore.pas │ ├── SpaceBeforeColon.pas │ ├── SpaceToTab.pas │ └── TabToSpace.pas ├── SwitchableVisitor.pas ├── Transform │ ├── AddBeginEnd.pas │ ├── AddBlockEndSemicolon.pas │ ├── FindReplace.pas │ ├── SortUses.pas │ ├── SortUsesData.pas │ ├── UsesClauseFindReplace.pas │ ├── UsesClauseInsert.pas │ └── UsesClauseRemove.pas ├── TreeWalker.pas ├── VisitSetNesting.pas ├── VisitSetXY.pas ├── VisitStripEmptySpace.pas └── Warnings │ ├── WarnAssignToFunctionName.pas │ ├── WarnCaseNoElse.pas │ ├── WarnDestroy.pas │ ├── WarnEmptyBlock.pas │ ├── WarnRealType.pas │ ├── WarnUnusedParam.pas │ └── Warning.pas ├── README.md ├── ReadWrite ├── CodeReader.pas ├── CodeWriter.pas ├── ConvertTypes.pas ├── Converter.pas ├── EditorConverter.pas ├── EditorReader.pas ├── EditorWriter.pas ├── FileConverter.pas ├── FileReader.pas ├── FileWriter.pas ├── StringsConverter.pas ├── StringsReader.pas └── StringsWriter.pas ├── Settings ├── JcfRegistrySettings.pas ├── JcfSetBase.pas ├── JcfSettings.pas ├── SetAlign.pas ├── SetAnyWordCaps.pas ├── SetAsm.pas ├── SetCaps.pas ├── SetClarify.pas ├── SetComments.pas ├── SetFile.pas ├── SetIndent.pas ├── SetObfuscate.pas ├── SetPreProcessor.pas ├── SetReplace.pas ├── SetReturns.pas ├── SetSpaces.pas ├── SetTransform.pas ├── SetUses.pas ├── SetWordList.pas ├── SettingsTypes.pas └── Streams │ ├── RegistrySettings.pas │ └── SettingsStream.pas ├── Ui ├── Settings │ ├── frAnyCapsSettings.lfm │ ├── frAnyCapsSettings.pas │ ├── frAsm.lfm │ ├── frAsm.pas │ ├── frBlankLines.lfm │ ├── frBlankLines.pas │ ├── frClarify.lfm │ ├── frClarify.pas │ ├── frClarifyAlign.lfm │ ├── frClarifyAlign.pas │ ├── frClarifyBlocks.lfm │ ├── frClarifyBlocks.pas │ ├── frClarifyCaseBlocks.lfm │ ├── frClarifyCaseBlocks.pas │ ├── frClarifyIndent.lfm │ ├── frClarifyIndent.pas │ ├── frClarifyLongLineBreaker.lfm │ ├── frClarifyLongLineBreaker.pas │ ├── frClarifyReturns.lfm │ ├── frClarifyReturns.pas │ ├── frClarifySpaces.lfm │ ├── frClarifySpaces.pas │ ├── frComments.lfm │ ├── frComments.pas │ ├── frCompilerDirectReturns.lfm │ ├── frCompilerDirectReturns.pas │ ├── frFiles.lfm │ ├── frFiles.pas │ ├── frIdentifierCapsSettings.lfm │ ├── frIdentifierCapsSettings.pas │ ├── frNotIdentifierCapsSettings.lfm │ ├── frNotIdentifierCapsSettings.pas │ ├── frObfuscateSettings.lfm │ ├── frObfuscateSettings.pas │ ├── frPreProcessor.lfm │ ├── frPreProcessor.pas │ ├── frReplace.lfm │ ├── frReplace.pas │ ├── frReservedCapsSettings.lfm │ ├── frReservedCapsSettings.pas │ ├── frTransform.lfm │ ├── frTransform.pas │ ├── frUnitCaps.lfm │ ├── frUnitCaps.pas │ ├── frUses.lfm │ ├── frUses.pas │ ├── frWarnings.lfm │ └── frWarnings.pas ├── fAbout.dfm ├── fAbout.lfm ├── fAbout.pas ├── fJcfErrorDisplay.dfm ├── fJcfErrorDisplay.lfm ├── fJcfErrorDisplay.pas ├── fRegistrySettings.dfm └── fRegistrySettings.pas ├── Utils ├── Delay.pas ├── DragDrop │ ├── JCFDropTarget.pas │ ├── frDrop.dfm │ └── frDrop.pas ├── IntList.pas ├── JcfFileUtils.pas ├── JcfFontSetFunctions.pas ├── JcfHelp.pas ├── JcfLog.pas ├── JcfMiscFunctions.pas ├── JcfStringUtils.pas ├── JcfSystemUtils.pas └── JcfUnicodeFiles.pas ├── jcf_vscode.gif ├── lazutils ├── FTL.TXT ├── LazLoggerImpl.inc ├── LazLoggerIntf.inc ├── Makefile ├── Makefile.compiled ├── Makefile.fpc ├── amigalazfileutils.inc ├── asiancodepagefunctions.inc ├── asiancodepages.inc ├── avglvltree.pas ├── dynamicarray.pas ├── dynhasharray.pp ├── dynqueue.pas ├── easylazfreetype.pas ├── extendedstrings.pas ├── fileutil.inc ├── fileutil.pas ├── fpcadds.pas ├── fpmake.pp ├── laz2_dom.pas ├── laz2_names.inc ├── laz2_xmlcfg.pas ├── laz2_xmlread.pas ├── laz2_xmlutils.pas ├── laz2_xmlwrite.pas ├── laz2_xpath.pas ├── laz_avl_tree.pp ├── laz_dom.pas ├── laz_xmlcfg.pas ├── laz_xmlread.pas ├── laz_xmlstreaming.pas ├── laz_xmlwrite.pas ├── lazclasses.pas ├── lazcollections.pas ├── lazconfigstorage.pas ├── lazdbglog.pas ├── lazfglhash.pas ├── lazfilecache.pas ├── lazfileutils.inc ├── lazfileutils.pas ├── lazfreetype.pas ├── lazfreetypefontcollection.pas ├── lazfreetypefpimagedrawer.pas ├── lazlinkedlist.pas ├── lazlogger.pas ├── lazloggerbase.pas ├── lazloggerdummy.pas ├── lazloggerprofiling.pas ├── lazmethodlist.pas ├── lazunicode.pas ├── lazutf16.pas ├── lazutf8.pas ├── lazutf8classes.pas ├── lazutf8sysutils.pas ├── lazutilities.pas ├── lazutils.lpk ├── lazutils.pas ├── lazutils_defines.inc ├── lazutilsstrconsts.pas ├── lconvencoding.pas ├── lcsvutils.pas ├── lookupstringlist.pas ├── maps.pp ├── masks.pas ├── paswstring.pas ├── stringhashlist.pas ├── textstrings.pas ├── translations.pas ├── ttcache.pas ├── ttcalc.pas ├── ttcalc1.inc ├── ttcalc2.inc ├── ttcalc3.inc ├── ttcalc4.inc ├── ttcmap.pas ├── ttconfig.inc ├── ttdebug.pas ├── tterror.pas ├── ttfile.pas ├── ttgload.pas ├── ttinterp.pas ├── ttload.pas ├── ttmemory.pas ├── ttobjs.pas ├── ttprofile.pas ├── ttraster.pas ├── ttraster_sweep.inc ├── tttables.pas ├── tttypes.pas ├── unixfileutil.inc ├── unixlazfileutils.inc ├── unixlazutf8.inc ├── utf8process.pp ├── winfileutil.inc ├── winlazfileutils.inc └── winlazutf8.inc ├── readme.txt └── test.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # OS or Editor folders 2 | ._* 3 | .cache 4 | .compiled 5 | .gitignore 6 | .DS_Store 7 | *.bak 8 | *.lps 9 | *.ppu 10 | *.o 11 | Output/*.rsj 12 | Output/*.res 13 | Output/*.sh 14 | Output/JCF 15 | Thumbs.db -------------------------------------------------------------------------------- /.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | { 2 | // See https://go.microsoft.com/fwlink/?LinkId=733558 3 | // for the documentation about the tasks.json format 4 | "version": "2.0.0", 5 | "tasks": [ 6 | { // shortcut: cmd+shift+B (run build task) 7 | "label" : "JCF: Build Release", 8 | "type" : "shell", 9 | "group" : { 10 | "kind" : "build", 11 | "isDefault": true, 12 | }, 13 | "options": { 14 | "cwd" : "CommandLine/Lazarus", 15 | }, 16 | "command": "fpc", 17 | "args" : [ 18 | "JCF.lpr", // source code file 19 | "-Px86_64", // target platform 64-bit 20 | "-Mobjfpc", // object pascal mode 21 | "-Schi", // pascal syntax setting 22 | "-CX", // generated code setting 23 | "-O3", // code optimization setting 24 | "-XXs", // executable setting 25 | "-B", // always build all 26 | "-v", // verbose message 27 | "-Fi../../Include", // include file path 28 | "-Fu../../lazutils", // unit file path 29 | "-FU../../Output", // unit output path 30 | "-FE../../Output", // executable output path 31 | ], 32 | "problemMatcher": [] 33 | }, 34 | { // shortcut: cmd+shift+R (run test task) 35 | "label": "JCF: Test CLI Program", 36 | "type" : "shell", 37 | "group": { 38 | "kind" : "test", 39 | "isDefault": true, 40 | }, 41 | "command": "Output/JCF", 42 | "args" : [ 43 | "test.pas", 44 | "-clarify", 45 | "-inplace", 46 | "-config=Output/jcf.xml" 47 | ], 48 | "presentation": { 49 | // open test.pas file to see the result 50 | "reveal": "never" 51 | }, 52 | "problemMatcher": [] 53 | }, 54 | { // shortcut: none 55 | "label" : "JCF: Clean Files", 56 | "type" : "shell", 57 | "command": "rm", 58 | "options": { 59 | "cwd" : "Output", 60 | }, 61 | "args" : [ 62 | // "JCF", // executable file 63 | "*.a", // generated linker file 64 | "*.o", // generated object file 65 | "*.s", // generated assembler file 66 | "*.out", // generated formatted code 67 | "*.ppu", // generated unit file 68 | "*.res", // generated resource file 69 | "*.rsj", // generated resource file 70 | "*.sh", // generated script code 71 | ], 72 | "problemMatcher": [] 73 | }, 74 | { // shortcut: none 75 | "label" : "JCF: Open CLI Project", 76 | "type" : "shell", 77 | "command": "code", 78 | "args" : [ 79 | "CommandLine/Lazarus/JCF.lpr", 80 | ], 81 | "presentation": { 82 | "reveal" : "never" 83 | }, 84 | "problemMatcher": [] 85 | }, 86 | { // shortcut: none 87 | "label" : "JCF: Deploy Executable", 88 | "type" : "shell", 89 | "command": "mv", 90 | "args" : [ 91 | "Output/JCF", 92 | "~/Documents/pascal/jcf", 93 | ], 94 | "presentation": { 95 | "reveal" : "silent" 96 | }, 97 | "problemMatcher": [] 98 | }, 99 | ], 100 | } -------------------------------------------------------------------------------- /CommandLine/CommandLineConstants.pas: -------------------------------------------------------------------------------- 1 | unit CommandLineConstants; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is CommandLineConstants, released August 2008. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses 33 | JcfStringUtils, 34 | JcfVersionConsts; 35 | 36 | const 37 | ABOUT_COMMANDLINE = 38 | 'JEDI Code Format V' + PROGRAM_VERSION + NativeLineBreak + 39 | ' ' + PROGRAM_DATE + NativeLineBreak + 40 | ' A Delphi Object-Pascal Source code formatter' + NativeLineBreak + 41 | ' A GUI version of this program is also available' + NativeLineBreak + 42 | ' Latest version at ' + PROGRAM_HOME_PAGE + NativeLineBreak + NativeLineBreak + 43 | 'Syntax: jcf [options] path/filename ' + NativeLineBreak + 44 | ' Parameters to the command-line program: ' + NativeLineBreak + NativeLineBreak + 45 | 46 | ' Mode of operation: ' + NativeLineBreak + 47 | ' -obfuscate Obfuscate mode or ' + NativeLineBreak + 48 | ' -clarify Clarify mode' + NativeLineBreak + 49 | ' When neither is specified, registry setting will be used.' + NativeLineBreak + 50 | ' This normally means clarify.' + NativeLineBreak + NativeLineBreak + 51 | 52 | ' Mode of source: ' + NativeLineBreak + 53 | ' -F Format a file. The file name must be specified.' + NativeLineBreak + 54 | ' -D Format a directory. The directory name must be specified.' + NativeLineBreak + 55 | ' -R Format a directory tree. The root directory name must be specified.' + 56 | NativeLineBreak + 57 | ' When no file mode is specified, registry setting will be used.' + 58 | NativeLineBreak + NativeLineBreak + 59 | 60 | ' Mode of output: ' + NativeLineBreak + 61 | ' -inplace change the source file without backup' + NativeLineBreak + 62 | ' -out output to a new file' + NativeLineBreak + 63 | ' -backup change the file and leave the original file as a backup' + NativeLineBreak + 64 | ' If no output mode is specified, registry setting will be used.' + 65 | NativeLineBreak + NativeLineBreak + 66 | 67 | ' Other options: ' + NativeLineBreak + 68 | ' -config=filename To specify a named configuration file' + NativeLineBreak + 69 | ' -y Overwrite files without confirmation.' + NativeLineBreak + 70 | ' -? Display this help' + NativeLineBreak; 71 | 72 | implementation 73 | 74 | end. 75 | -------------------------------------------------------------------------------- /CommandLine/CommandLineReturnCode.pas: -------------------------------------------------------------------------------- 1 | unit CommandLineReturnCode; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is CommandLineReturnCode, released August 2008. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { 33 | command line return code 34 | 0 for sucess 35 | non-sero for failure codes 36 | } 37 | type 38 | TJcfCommandLineReturnCode = 39 | ( 40 | rcSuccess = 0, 41 | rcGeneralFailure = 1, 42 | rcNoPathFound = 2, 43 | rcConfigFileNotFound = 3, 44 | rcSettingsNotRead = 4, 45 | rcFileNotFound = 5, 46 | rcDirectoryNotFound = 6, 47 | rcConvertError = 7 48 | ); 49 | 50 | procedure HaltOnError(const returnCode: TJcfCommandLineReturnCode); 51 | 52 | implementation 53 | 54 | procedure HaltOnError(const returnCode: TJcfCommandLineReturnCode); 55 | var 56 | liCode: integer; 57 | begin 58 | liCode := Ord(returnCode); 59 | 60 | if liCode > 0 then 61 | begin 62 | Halt(liCode); 63 | end; 64 | 65 | end; 66 | 67 | end. 68 | -------------------------------------------------------------------------------- /CommandLine/StatusMessageReceiver.pas: -------------------------------------------------------------------------------- 1 | unit StatusMessageReceiver; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is StatusMessageReceiver, released August 2008. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses 33 | ConvertTypes; 34 | 35 | type 36 | TStatusMesssageReceiver = class(TObject) 37 | public 38 | procedure OnReceiveStatusMessage(const psFile, psMessage: string; 39 | const peMessageType: TStatusMessageType; 40 | const piY, piX: integer); 41 | end; 42 | 43 | implementation 44 | 45 | uses 46 | SysUtils; 47 | 48 | { An attempt at an emacs version } 49 | procedure TStatusMesssageReceiver.OnReceiveStatusMessage(const psFile, psMessage: string; 50 | const peMessageType: TStatusMessageType; 51 | const piY, piX: integer); 52 | var 53 | lsPrefix: string; 54 | lsMessage: string; 55 | begin 56 | case peMessageType of 57 | mtException, mtInputError, mtParseError: 58 | lsPrefix := 'Error'; 59 | mtCodeWarning: 60 | lsPrefix := 'Warning'; 61 | end; 62 | 63 | if (piX < 0) or (piY < 0) then 64 | begin 65 | // format with no line and col 66 | lsMessage := Format('%s %s %s', [psFile, lsPrefix, psMessage]); 67 | end 68 | else 69 | begin 70 | // format with a line and col 71 | lsMessage := Format('%s(%s,%s) %s %s', 72 | [psFile, IntToStr(piY), IntToStr(piX), lsPrefix, psMessage]); 73 | end; 74 | 75 | WriteLn(lsMessage); 76 | end; 77 | 78 | { 79 | procedure TStatusMesssageReceiver.OnReceiveStatusMessage(const psFile, psMessage: string; 80 | const peMessageType: TStatusMessageType; 81 | const piY, piX: integer); 82 | var 83 | lsMessage: string; 84 | begin 85 | if Pos(psFile, psMessage) = 0 then 86 | lsMessage := psFile + ': ' + psMessage 87 | else 88 | lsMessage := psMessage; 89 | 90 | if (piY >= 0) then 91 | lsMessage := lsMessage + ' at line ' + IntToStr(piY); 92 | if (piX >= 0) then 93 | lsMessage := lsMessage + ' col ' + IntToStr(piX); 94 | 95 | WriteLn(lsMessage); 96 | end; 97 | } 98 | 99 | end. 100 | -------------------------------------------------------------------------------- /CommandLine/jcf.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=1 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir=..\Output 94 | UnitOutputDir=..\Output 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath= 98 | Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;dclOffice2k;DJCL70;qrpt 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams=-config=C:\Code\CodeFormat\Jcf2\Test\TestCases\JCFTestSettings.cfg -out -F C:\Code\CodeFormat\Jcf2\Test\TestCases\EmptyTest1.pas 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir= 112 | [Version Info] 113 | IncludeVerInfo=0 114 | AutoIncBuild=0 115 | MajorVer=1 116 | MinorVer=0 117 | Release=0 118 | Build=0 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=2057 125 | CodePage=1252 126 | -------------------------------------------------------------------------------- /Contributions/StyleEditor/JCFStyle.cfg: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 29 | -H+ 30 | -W+ 31 | -M 32 | -$M16384,1048576 33 | -K$00400000 34 | -LE"C:\Documents and Settings\Anthony\My Documents\Borland Studio Projects\Bpl" 35 | -LN"C:\Documents and Settings\Anthony\My Documents\Borland Studio Projects\Bpl" 36 | -w-UNSAFE_TYPE 37 | -w-UNSAFE_CODE 38 | -w-UNSAFE_CAST 39 | -------------------------------------------------------------------------------- /Contributions/StyleEditor/JCFStyle.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/Contributions/StyleEditor/JCFStyle.res -------------------------------------------------------------------------------- /Contributions/StyleEditor/Readme.txt: -------------------------------------------------------------------------------- 1 | Standalone Style Editor of JEDI Code Format 1.0 2 | 3 | Introduction 4 | 5 | When I develop Code Beautifier Collection 6.0 (code named GrapeVine), I found that a standalone Style file editor is necessary even though Anthony creates a bunch of projects already (commandline, GUI, IDE experts, and Notepad). 6 | 7 | I rip a few files out of Notepad project, so a simple editor is crearted. It meets all Code Beautifier Collection reu=quirements, 8 | 9 | 1. standalone. 10 | 2. it only edits the JCFSettings.cfg file in the same folder (never touch the one defined in registry). 11 | 12 | Source File 13 | 14 | The zip package contains a folder named Style. Extract it and place in JCF source code root folder (in the same level of Commandline). Then open the project in Delphi 2007 (JCL and JVCL must be installed). 15 | 16 | Limitation 17 | 18 | This project is created for Code Beautifier Collection only. 19 | 20 | License 21 | 22 | This project is licensed under MPL, the same as original JCF. 23 | 24 | Li Yang 25 | http://lextm.blogspot.com 26 | Code Beautifier Collection 27 | http://code.google.com/p/lextudio -------------------------------------------------------------------------------- /IdePlugin/lazarus/Makefile.compiled: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /IdePlugin/lazarus/Makefile.fpc: -------------------------------------------------------------------------------- 1 | # File generated automatically by Lazarus Package Manager 2 | # 3 | # Makefile.fpc for jcfidelazarus 2.0 4 | # 5 | # This file was generated on 1-10-15 6 | 7 | [package] 8 | name=jcfidelazarus 9 | version=2.0 10 | 11 | [compiler] 12 | unittargetdir=lib/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) 13 | unitdir=../.. ../../Parse ../../Parse/PreProcessor ../../Parse/UI ../../Process ../../Process/Align ../../Process/Capitalisation ../../Process/Indent ../../Process/Info ../../Process/Obfuscate ../../Process/Onceoffs ../../Process/Returns ../../Process/Spacing ../../Process/Transform ../../Process/Warnings ../../ReadWrite ../../Settings ../../Settings/Streams ../../Ui ../../Ui/Settings ../../Utils ../../Utils/DragDrop ../../../../packager/units/$(CPU_TARGET)-$(OS_TARGET) ../../../lazutils/lib/$(CPU_TARGET)-$(OS_TARGET) ../../../../lcl/units/$(CPU_TARGET)-$(OS_TARGET) ../../../../lcl/units/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) ../../../lazcontrols/lib/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) ../../../ideintf/units/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) . 14 | includedir=../../Include ../../Ui/Settings 15 | options= -MObjFPC -Sgi -O1 -g -gl -l -vewnhibq -dLCL -dLCL$(LCL_PLATFORM) $(DBG_OPTIONS) 16 | 17 | [target] 18 | units=jcfidelazarus.pas 19 | 20 | [clean] 21 | files=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) \ 22 | $(wildcard $(COMPILER_UNITTARGETDIR)/*$(PPUEXT)) \ 23 | $(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) \ 24 | $(wildcard $(COMPILER_UNITTARGETDIR)/*.lfm) \ 25 | $(wildcard $(COMPILER_UNITTARGETDIR)/*.res) \ 26 | $(wildcard $(COMPILER_UNITTARGETDIR)/*.compiled) \ 27 | $(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT)) 28 | [prerules] 29 | # LCL Platform 30 | ifndef LCL_PLATFORM 31 | ifeq ($(OS_TARGET),win32) 32 | LCL_PLATFORM=win32 33 | else 34 | ifeq ($(OS_TARGET),win64) 35 | LCL_PLATFORM=win32 36 | else 37 | ifeq ($(OS_TARGET),darwin) 38 | LCL_PLATFORM=carbon 39 | else 40 | LCL_PLATFORM=gtk2 41 | endif 42 | endif 43 | endif 44 | endif 45 | export LCL_PLATFORM 46 | 47 | DBG_OPTIONS= 48 | ifeq ($(OS_TARGET),darwin) 49 | DBG_OPTIONS=-gw 50 | endif 51 | 52 | [rules] 53 | .PHONY: cleartarget compiled all 54 | 55 | cleartarget: 56 | -$(DEL) $(COMPILER_UNITTARGETDIR)/jcfidelazarus$(PPUEXT) 57 | 58 | compiled: 59 | $(CPPROG) -f Makefile.compiled $(COMPILER_UNITTARGETDIR)/jcfidelazarus.compiled 60 | 61 | all: cleartarget $(COMPILER_UNITTARGETDIR) jcfidelazarus$(PPUEXT) compiled 62 | 63 | distclean: clean 64 | ${DELTREE} lib/* 65 | -------------------------------------------------------------------------------- /IdePlugin/lazarus/jcfidelazarus.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit jcfidelazarus; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | JcfIdeMain, JcfIdeRegister, AsmKeywords, BuildParseTree, BuildTokenList, 12 | ParseError, ParseTreeNode, ParseTreeNodeType, PreProcessorExpressionParser, 13 | PreProcessorExpressionTokenise, PreProcessorExpressionTokens, 14 | PreProcessorParseTree, SourceToken, SourceTokenList, Tokens, TokenUtils, 15 | fShowParseTree, AlignAssign, AlignBase, AlignComment, AlignConst, 16 | AlignField, AlignTypedef, AlignVars, AllProcesses, BaseVisitor, 17 | Capitalisation, IdentifierCaps, SpecificWordCaps, UnitNameCaps, FormatFlags, 18 | IndentAsmParam, Indenter, BasicStats, Nesting, FixCase, RebreakLines, 19 | ReduceWhiteSpace, RemoveBlankLine, RemoveComment, 20 | RemoveConsecutiveWhiteSpace, RemoveReturn, RemoveUnneededWhiteSpace, 21 | MozComment, RemoveEmptyComment, BlockStyles, LongLineBreaker, NoReturnAfter, 22 | NoReturnBefore, PropertyOnOneLine, RemoveBlankLinesAfterProcHeader, 23 | RemoveBlankLinesInVars, RemoveConsecutiveReturns, RemoveReturnsAfter, 24 | RemoveReturnsAfterBegin, RemoveReturnsBeforeEnd, ReturnAfter, ReturnBefore, 25 | ReturnChars, ReturnsAfterFinalEnd, MaxSpaces, NoSpaceAfter, NoSpaceBefore, 26 | RemoveSpaceAtLineEnd, SingleSpaceAfter, SingleSpaceBefore, SpaceBeforeColon, 27 | SpaceToTab, TabToSpace, SwitchableVisitor, AddBeginEnd, 28 | AddBlockEndSemicolon, FindReplace, SortUses, SortUsesData, 29 | UsesClauseFindReplace, UsesClauseInsert, UsesClauseRemove, TreeWalker, 30 | VisitSetNesting, VisitSetXY, VisitStripEmptySpace, WarnAssignToFunctionName, 31 | WarnCaseNoElse, WarnDestroy, WarnEmptyBlock, Warning, WarnRealType, 32 | WarnUnusedParam, Converter, ConvertTypes, EditorConverter, FileConverter, 33 | JcfRegistrySettings, JcfSetBase, JcfSettings, SetAlign, SetAsm, SetCaps, 34 | SetClarify, SetComments, SetIndent, SetObfuscate, SetPreProcessor, 35 | SetReplace, SetReturns, SetSpaces, SettingsTypes, SetTransform, SetUses, 36 | SetWordList, SettingsStream, fJcfErrorDisplay, Delay, IntList, 37 | JcfFontSetFunctions, JcfHelp, JcfLog, JcfMiscFunctions, fAbout, 38 | JcfVersionConsts, frFiles, frObfuscateSettings, frClarify, frClarifySpaces, 39 | frClarifyIndent, frBlankLines, frClarifyAlign, frClarifyLongLineBreaker, 40 | frClarifyReturns, frCompilerDirectReturns, frClarifyBlocks, 41 | frClarifyCaseBlocks, frComments, frWarnings, frReservedCapsSettings, 42 | frAnyCapsSettings, frIdentifierCapsSettings, frNotIdentifierCapsSettings, 43 | frUnitCaps, frReplace, frUses, frTransform, frAsm, frPreProcessor, 44 | jcfuiconsts, LazarusPackageIntf; 45 | 46 | implementation 47 | 48 | procedure Register; 49 | begin 50 | RegisterUnit('JcfIdeRegister', @JcfIdeRegister.Register); 51 | end; 52 | 53 | initialization 54 | RegisterPackage('jcfidelazarus', @Register); 55 | end. 56 | -------------------------------------------------------------------------------- /IdePlugin/lazarus/jcfsettings.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/IdePlugin/lazarus/jcfsettings.res -------------------------------------------------------------------------------- /Include/JcfGlobal.inc: -------------------------------------------------------------------------------- 1 | {$DEFINE COMMAND_LINE} 2 | {$IFDEF FPC} 3 | // FreePascal must be in Delphi mode 4 | {$MODE delphi} 5 | {$ELSE} 6 | {$DEFINE USEJCL} 7 | 8 | // define the appropriate DelphiXX constants 9 | 10 | {$IFDEF VER210} 11 | {$IFDEF BCB} 12 | {$DEFINE BCB14} 13 | {$ELSE} 14 | {$DEFINE DELPHI14} 15 | {$ENDIF} 16 | {$ENDIF} 17 | 18 | {$IFDEF VER200} 19 | {$IFDEF BCB} 20 | {$DEFINE BCB12} 21 | {$ELSE} 22 | {$DEFINE DELPHI12} 23 | {$ENDIF} 24 | {$ENDIF} 25 | 26 | {$IFDEF VER190} 27 | {$DEFINE DELPHI11} 28 | {$ENDIF} 29 | 30 | {$IFDEF VER180} 31 | {$IFDEF VER185} 32 | {$IFDEF BCB} 33 | {$DEFINE BCB11} 34 | {$ELSE} 35 | {$DEFINE DELPHI11} 36 | {$ENDIF} 37 | {$ELSE} 38 | {$IFDEF BCB} 39 | {$DEFINE BCB10} 40 | {$ELSE} 41 | {$DEFINE DELPHI10} 42 | {$ENDIF} 43 | {$ENDIF} 44 | {$ENDIF} 45 | 46 | {$IFDEF VER170} 47 | {$DEFINE DELPHI9} 48 | {$ENDIF} 49 | 50 | {$IFDEF VER160} 51 | {$DEFINE DELPHI8} 52 | {$ENDIF} 53 | 54 | {$IFDEF VER150} 55 | {$DEFINE DELPHI7} 56 | {$ENDIF} 57 | 58 | {$IFDEF VER140} 59 | {$IFDEF BCB} 60 | {$DEFINE BCB6} 61 | {$ELSE} 62 | {$DEFINE DELPHI6} 63 | {$ENDIF} 64 | {$ENDIF} 65 | 66 | {$IFDEF VER130} 67 | {$IFDEF BCB} 68 | {$DEFINE BCB5} 69 | {$ELSE} 70 | {$DEFINE DELPHI5} 71 | {$ENDIF} 72 | {$ENDIF} 73 | 74 | {$IFDEF VER125} 75 | {$DEFINE BCB4} 76 | {$ENDIF} 77 | 78 | {$IFDEF VER120} 79 | {$DEFINE DELPHI4} 80 | {$ENDIF} 81 | 82 | {$IFDEF VER110} 83 | {$DEFINE BCB3} 84 | {$ENDIF} 85 | 86 | {$IFDEF VER100} 87 | {$DEFINE DELPHI3} 88 | {$ENDIF} 89 | 90 | {$IFDEF VER93} 91 | {$DEFINE BCB1} 92 | {$ENDIF} 93 | 94 | {$IFDEF VER90} 95 | {$DEFINE DELPHI2} 96 | {$ENDIF} 97 | 98 | {$IFDEF VER80} 99 | {$DEFINE DELPHI1} 100 | {$ENDIF} 101 | {$ENDIF} 102 | -------------------------------------------------------------------------------- /JCF.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/JCF.ico -------------------------------------------------------------------------------- /JCFAllD11.bpg: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | VERSION = BWS.01 3 | #------------------------------------------------------------------------------ 4 | !ifndef ROOT 5 | ROOT = $(MAKEDIR)\.. 6 | !endif 7 | #------------------------------------------------------------------------------ 8 | MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** 9 | DCC = $(ROOT)\bin\dcc32.exe $** 10 | BRCC = $(ROOT)\bin\brcc32.exe $** 11 | #------------------------------------------------------------------------------ 12 | PROJECTS = JCFGui.exe JCFNotepad.exe JCFIdeD11.bpl jcf.exe jcf_test.exe \ 13 | TestCases.exe 14 | #------------------------------------------------------------------------------ 15 | default: $(PROJECTS) 16 | #------------------------------------------------------------------------------ 17 | 18 | JCFNotepad.exe: Notepad\D11\JCFNotepad.dpr 19 | $(DCC) 20 | 21 | JCFGui.exe: JCFGui\D11\JCFGui.dpr 22 | $(DCC) 23 | 24 | JCFGui.exe: JCFGui\D11\JCFGui.dpr 25 | $(DCC) 26 | 27 | JCFIdeD11.bpl: IdePlugin\D11\JCFIdeD11.dpk 28 | $(DCC) 29 | 30 | jcf.exe: CommandLine\D11\jcf.dpr 31 | $(DCC) 32 | 33 | TestCases.exe: Test\TestCases\D11\TestCases.dpr 34 | $(DCC) 35 | 36 | jcf_test.exe: Test\DUnit\D11\jcf_test.dpr 37 | $(DCC) 38 | 39 | 40 | -------------------------------------------------------------------------------- /JCFAllD12.bpg: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | VERSION = BWS.01 3 | #------------------------------------------------------------------------------ 4 | !ifndef ROOT 5 | ROOT = $(MAKEDIR)\.. 6 | !endif 7 | #------------------------------------------------------------------------------ 8 | MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** 9 | DCC = $(ROOT)\bin\dcc32.exe $** 10 | BRCC = $(ROOT)\bin\brcc32.exe $** 11 | #------------------------------------------------------------------------------ 12 | PROJECTS = JCFGui.exe JCFNotepad.exe JCFIdeD12.bpl jcf.exe jcf_test.exe \ 13 | TestCases.exe 14 | #------------------------------------------------------------------------------ 15 | default: $(PROJECTS) 16 | #------------------------------------------------------------------------------ 17 | 18 | JCFNotepad.exe: Notepad\D12\JCFNotepad.dpr 19 | $(DCC) 20 | 21 | JCFGui.exe: JCFGui\D12\JCFGui.dpr 22 | $(DCC) 23 | 24 | JCFGui.exe: JCFGui\D12\JCFGui.dpr 25 | $(DCC) 26 | 27 | JCFIdeD12.bpl: IdePlugin\D12\JCFIdeD12.dpk 28 | $(DCC) 29 | 30 | jcf.exe: CommandLine\D12\jcf.dpr 31 | $(DCC) 32 | 33 | TestCases.exe: Test\TestCases\D12\TestCases.dpr 34 | $(DCC) 35 | 36 | jcf_test.exe: Test\DUnit\D12\jcf_test.dpr 37 | $(DCC) 38 | 39 | 40 | -------------------------------------------------------------------------------- /JcfGui/jcfGui.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir=..\Output 94 | UnitOutputDir=..\Output 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath= 98 | Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;dclOffice2k;DJcl;qrpt;JvCoreD7R;JvCustomD7R;JvStdCtrlsD7R;JvSystemD7R;JvCtrlsD7R 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir= 112 | [Version Info] 113 | IncludeVerInfo=0 114 | AutoIncBuild=0 115 | MajorVer=1 116 | MinorVer=0 117 | Release=0 118 | Build=0 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=2057 125 | CodePage=1252 126 | [Version Info Keys] 127 | CompanyName= 128 | FileDescription= 129 | FileVersion=1.0.0.0 130 | InternalName= 131 | LegalCopyright= 132 | LegalTrademarks= 133 | OriginalFilename= 134 | ProductName= 135 | ProductVersion=1.0.0.0 136 | Comments= 137 | [Excluded Packages] -------------------------------------------------------------------------------- /JcfVersionConsts.pas: -------------------------------------------------------------------------------- 1 | unit JcfVersionConsts; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is JcfVersionConsts, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 2003-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | const 33 | PROGRAM_VERSION = '2.44'; 34 | PROGRAM_DATE = 'August 2009'; 35 | PROGRAM_HOME_PAGE = 'http://jedicodeformat.sourceforge.net/'; 36 | PROGRAM_SOURCEFORGE_HOME_PAGE = 'http://sourceforge.net/projects/jedicodeformat/'; 37 | PROGRAM_SVN_TRUNK = 'http://jedicodeformat.svn.sourceforge.net/svnroot/jedicodeformat/trunk/CodeFormat/Jcf2/'; 38 | 39 | implementation 40 | 41 | end. 42 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 Bee Jay 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Output/Lazarus/README.md: -------------------------------------------------------------------------------- 1 | ## File Description: 2 | 3 | - `jcf-linux-64` (772 KB) is executable binary file for Linux 64 bit systems. 4 | - `jcf-linux.zip` (281 KB) is compressed file containing JCF executable and config file for Linux 64 bit systems. 5 | - `jcf-osx-64` (961 KB) is executable binary file for Mac OSX 64 bit systems. 6 | - `jcf-osx.zip` (336 KB) is compressed file containing JCF executable and config file for Mac OSX 64 bit systems. 7 | - `jcf-win-32` (524 KB) is executable binary file for Windows 32 bit systems. 8 | - `jcf-win-64` (733 KB) is executable binary file for Windows 64 bit systems. 9 | - `jcf-win.zip` (481 KB) is compressed file containing JCF executable and config file for all Windows systems. 10 | - `jcf.xml` (11 KB) is Lazarus' default JCF configuration file for all systems. 11 | 12 | After you download any of them, you should rename the executable file into simply `jcf` for ease of use. 13 | -------------------------------------------------------------------------------- /Output/Lazarus/jcf-linux-64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/Output/Lazarus/jcf-linux-64 -------------------------------------------------------------------------------- /Output/Lazarus/jcf-linux.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/Output/Lazarus/jcf-linux.zip -------------------------------------------------------------------------------- /Output/Lazarus/jcf-osx-64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/Output/Lazarus/jcf-osx-64 -------------------------------------------------------------------------------- /Output/Lazarus/jcf-osx.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/Output/Lazarus/jcf-osx.zip -------------------------------------------------------------------------------- /Output/Lazarus/jcf-win-32.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/Output/Lazarus/jcf-win-32.exe -------------------------------------------------------------------------------- /Output/Lazarus/jcf-win-64.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/Output/Lazarus/jcf-win-64.exe -------------------------------------------------------------------------------- /Output/Lazarus/jcf-win.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/Output/Lazarus/jcf-win.zip -------------------------------------------------------------------------------- /Parse/ParseError.pas: -------------------------------------------------------------------------------- 1 | unit ParseError; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is ParseError, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses 33 | {delphi } 34 | SysUtils, 35 | { local } 36 | SourceToken; 37 | 38 | type 39 | TEParseError = class(Exception) 40 | private 41 | fcToken: TSourceToken; 42 | fiXPosition, fiYPosition: integer; 43 | fsFileName: string; 44 | 45 | function GetTokenMessage: string; 46 | public 47 | constructor Create(const psMessage: string; const pcToken: TSourceToken); 48 | 49 | property FileName: string Read fsFileName Write fsFileName; 50 | property TokenMessage: string Read GetTokenMessage; 51 | property XPosition: integer Read fiXPosition; 52 | property YPosition: integer Read fiYPosition; 53 | 54 | end; 55 | 56 | implementation 57 | 58 | { TEParseError } 59 | 60 | constructor TEParseError.Create(const psMessage: string; const pcToken: TSourceToken); 61 | begin 62 | inherited Create(psMessage); 63 | 64 | fcToken := pcToken; 65 | if pcToken <> nil then 66 | begin 67 | fiXPosition := pcToken.XPosition; 68 | fiYPosition := pcToken.YPosition; 69 | end 70 | else 71 | begin 72 | fiXPosition := -1; 73 | fiYPosition := -1; 74 | end; 75 | end; 76 | 77 | function TEParseError.GetTokenMessage: string; 78 | begin 79 | if fcToken = nil then 80 | Result := '' 81 | else 82 | Result := fcToken.Describe; 83 | end; 84 | 85 | end. 86 | -------------------------------------------------------------------------------- /Process/Align/AlignConst.pas: -------------------------------------------------------------------------------- 1 | {(*} 2 | (*------------------------------------------------------------------------------ 3 | Delphi Code formatter source code 4 | 5 | The Original Code is AlignConst.pas, released April 2000. 6 | The Initial Developer of the Original Code is Anthony Steele. 7 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 8 | All Rights Reserved. 9 | Contributor(s): Anthony Steele. 10 | 11 | The contents of this file are subject to the Mozilla Public License Version 1.1 12 | (the "License"). you may not use this file except in compliance with the License. 13 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 14 | 15 | Software distributed under the License is distributed on an "AS IS" basis, 16 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 17 | See the License for the specific language governing rights and limitations 18 | under the License. 19 | 20 | Alternatively, the contents of this file may be used under the terms of 21 | the GNU General Public License Version 2 or later (the "GPL") 22 | See http://www.gnu.org/licenses/gpl.html 23 | ------------------------------------------------------------------------------*) 24 | {*)} 25 | 26 | unit AlignConst; 27 | 28 | { AFS 3 Feb 2K 29 | Align the RHS of consecutive = signs in a const section 30 | } 31 | 32 | {$I JcfGlobal.inc} 33 | 34 | interface 35 | 36 | uses SourceToken, AlignBase; 37 | 38 | type 39 | 40 | TAlignConst = class(TAlignBase) 41 | private 42 | protected 43 | { TokenProcessor overrides } 44 | function IsTokenInContext(const pt: TSourceToken): boolean; override; 45 | 46 | { AlignStatements overrides } 47 | function TokenIsAligned(const pt: TSourceToken): boolean; override; 48 | function TokenEndsStatement(const pt: TSourceToken): boolean; override; 49 | 50 | public 51 | constructor Create; override; 52 | 53 | function IsIncludedInSettings: boolean; override; 54 | end; 55 | 56 | implementation 57 | 58 | uses 59 | { local} 60 | FormatFlags, JcfSettings, 61 | Tokens, ParseTreeNodeType, TokenUtils; 62 | 63 | 64 | constructor TAlignConst.Create; 65 | begin 66 | inherited; 67 | FormatFlags := FormatFlags + [eAlignConst]; 68 | end; 69 | 70 | function TAlignConst.IsIncludedInSettings: boolean; 71 | begin 72 | Result := ( not FormatSettings.Obfuscate.Enabled) and FormatSettings.Align.AlignConst; 73 | end; 74 | 75 | { a token that ends an const block } 76 | function TAlignConst.TokenEndsStatement(const pt: TSourceToken): boolean; 77 | begin 78 | if pt = nil then 79 | Result := True 80 | { only look at solid tokens } 81 | else if (pt.TokenType in [ttReturn, ttWhiteSpace]) then 82 | begin 83 | // ended by a blank line 84 | Result := IsBlankLineEnd(pt); 85 | end 86 | else 87 | begin 88 | Result := ( not pt.HasParentNode(nConstSection)) or 89 | (pt.TokenType in [ttSemiColon]) or (pt.WordType = wtReservedWord); 90 | end; 91 | end; 92 | 93 | function TAlignConst.IsTokenInContext(const pt: TSourceToken): boolean; 94 | begin 95 | Result := (pt <> nil) and (pt.HasParentNode(nConstSection)) and 96 | (( not FormatSettings.Align.InterfaceOnly)) or (pt.HasParentNode(nInterfaceSection)); 97 | end; 98 | 99 | function TAlignConst.TokenIsAligned(const pt: TSourceToken): boolean; 100 | begin 101 | Result := (pt.TokenType = ttEquals) and (not pt.HasParentNode(nLiteralString)); 102 | end; 103 | 104 | end. 105 | -------------------------------------------------------------------------------- /Process/Obfuscate/RebreakLines.pas: -------------------------------------------------------------------------------- 1 | unit RebreakLines; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is RebreakLines, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { AFS 29 December 2002 33 | 34 | Obfuscate process 35 | break lines at regular intervals 36 | } 37 | 38 | uses SwitchableVisitor; 39 | 40 | type 41 | TRebreakLines = class(TSwitchableVisitor) 42 | private 43 | xPos: integer; 44 | protected 45 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 46 | public 47 | constructor Create; override; 48 | end; 49 | 50 | implementation 51 | 52 | uses 53 | JcfStringUtils, SourceToken, Tokens, FormatFlags, TokenUtils, ParseTreeNodeType; 54 | 55 | function CanBreakHere(const pt: TSourceToken): boolean; 56 | var 57 | lbInString: Boolean; 58 | lcNext: TSourceToken; 59 | begin 60 | lbInString := pt.HasParentNode(nLiteralString); 61 | if lbInString then 62 | begin 63 | lcNext := pt.NextToken; 64 | lbInString := (lcNext <> nil) and lcNext.HasParentNode(nLiteralString); 65 | end; 66 | 67 | Result := not lbInString; 68 | end; 69 | 70 | constructor TRebreakLines.Create; 71 | begin 72 | inherited; 73 | FormatFlags := FormatFlags + [eObfuscate]; 74 | xPos := 1; 75 | end; 76 | 77 | function TRebreakLines.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 78 | const 79 | LINE_LENGTH = 80; 80 | var 81 | lcToken: TSourceToken; 82 | lcNext, lcNew: TSourceToken; 83 | liLen: integer; 84 | begin 85 | Result := False; 86 | lcToken := TSourceToken(pcNode); 87 | 88 | if lcToken.TokenType = ttReturn then 89 | begin 90 | xPos := 0 91 | end 92 | else 93 | begin 94 | liLen := Length(lcToken.SourceCode); 95 | 96 | if ((XPos + liLen) > LINE_LENGTH) and CanBreakHere(lcToken) then 97 | begin 98 | { no space directly after the new return } 99 | lcNext := lcToken.NextToken; 100 | if (lcNext <> nil) and (lcNext.TokenType = ttWhiteSpace) and 101 | (lcNext.SourceCode <> '') then 102 | BlankToken(lcNext); 103 | 104 | { need a return? } 105 | if (lcNext <> nil) and (lcNext.TokenType <> ttReturn) then 106 | begin 107 | 108 | lcNew := TSourceToken.Create; 109 | lcNew.TokenType := ttReturn; 110 | lcNew.SourceCode := NativeLineBreak; 111 | XPos := 0; 112 | 113 | InsertTokenAfter(lcToken, lcNew); 114 | end; 115 | end 116 | else 117 | // not at enhd of line yet 118 | xPos := xPos + liLen; 119 | end; 120 | end; 121 | 122 | end. 123 | -------------------------------------------------------------------------------- /Process/Obfuscate/ReduceWhiteSpace.pas: -------------------------------------------------------------------------------- 1 | unit ReduceWhiteSpace; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is ReduceWhiteSpace, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { AFS 28 Dec 2002 33 | 34 | Visitor to reduce all whitespace to single spaces 35 | Obfuscation 36 | } 37 | 38 | uses SwitchableVisitor; 39 | 40 | type 41 | TReduceWhiteSpace = class(TSwitchableVisitor) 42 | protected 43 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 44 | public 45 | constructor Create; override; 46 | end; 47 | 48 | 49 | implementation 50 | 51 | uses SourceToken, Tokens, FormatFlags; 52 | 53 | constructor TReduceWhiteSpace.Create; 54 | begin 55 | inherited; 56 | FormatFlags := FormatFlags + [eObfuscate]; 57 | end; 58 | 59 | function TReduceWhiteSpace.EnabledVisitSourceToken(const pcNode: TObject): boolean; 60 | var 61 | lcSourceToken: TSourceToken; 62 | begin 63 | Result := False; 64 | lcSourceToken := TSourceToken(pcNode); 65 | 66 | if lcSourceToken.TokenType = ttWhiteSpace then 67 | lcSourceToken.SourceCode := ' '; 68 | end; 69 | 70 | end. 71 | -------------------------------------------------------------------------------- /Process/Obfuscate/RemoveBlankLine.pas: -------------------------------------------------------------------------------- 1 | unit RemoveBlankLine; 2 | 3 | { AFS 17 Jan 2003 4 | Obfuscate - remove blank lines } 5 | 6 | {(*} 7 | (*------------------------------------------------------------------------------ 8 | Delphi Code formatter source code 9 | 10 | The Original Code is RemoveBlankLine, released May 2003. 11 | The Initial Developer of the Original Code is Anthony Steele. 12 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 13 | All Rights Reserved. 14 | Contributor(s): Anthony Steele. 15 | 16 | The contents of this file are subject to the Mozilla Public License Version 1.1 17 | (the "License"). you may not use this file except in compliance with the License. 18 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 19 | 20 | Software distributed under the License is distributed on an "AS IS" basis, 21 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 22 | See the License for the specific language governing rights and limitations 23 | under the License. 24 | 25 | Alternatively, the contents of this file may be used under the terms of 26 | the GNU General Public License Version 2 or later (the "GPL") 27 | See http://www.gnu.org/licenses/gpl.html 28 | ------------------------------------------------------------------------------*) 29 | {*)} 30 | 31 | {$I JcfGlobal.inc} 32 | 33 | interface 34 | 35 | uses SwitchableVisitor; 36 | 37 | type 38 | TRemoveBlankLine = class(TSwitchableVisitor) 39 | protected 40 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 41 | public 42 | constructor Create; override; 43 | end; 44 | 45 | implementation 46 | 47 | uses 48 | SourceToken, Tokens, 49 | FormatFlags, TokenUtils; 50 | 51 | 52 | constructor TRemoveBlankLine.Create; 53 | begin 54 | inherited; 55 | FormatFlags := FormatFlags + [eObfuscate]; 56 | end; 57 | 58 | function TRemoveBlankLine.EnabledVisitSourceToken(const pcNode: TObject): boolean; 59 | var 60 | lcSourceToken, lcNext: TSourceToken; 61 | begin 62 | Result := False; 63 | lcSourceToken := TSourceToken(pcNode); 64 | 65 | if lcSourceToken.TokenType <> ttReturn then 66 | exit; 67 | 68 | { find next, excluding spaces and comments, except '//' comment } 69 | lcNext := lcSourceToken.NextTokenWithExclusions([ttWhiteSpace]); 70 | while (lcNext <> nil) and (lcNext.TokenType = ttComment) and 71 | (lcNext.CommentStyle <> eDoubleSlash) do 72 | lcNext := lcNext.NextTokenWithExclusions([ttWhiteSpace]); 73 | 74 | { 75 | A return, followed by another return (with nothing of substance between them) 76 | is a blank line, so kill one of them 77 | this applies even in Asm blocks } 78 | if (lcNext <> nil) and (lcNext.TokenType = ttReturn) then 79 | BlankToken(lcSourceToken); 80 | 81 | end; 82 | 83 | end. 84 | -------------------------------------------------------------------------------- /Process/Obfuscate/RemoveComment.pas: -------------------------------------------------------------------------------- 1 | unit RemoveComment; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is RemoveComment, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { AFS 28 Dec 2002 33 | 34 | Obfuscate by removing comments 35 | } 36 | 37 | uses SwitchableVisitor; 38 | 39 | type 40 | TRemoveComment = class(TSwitchableVisitor) 41 | protected 42 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 43 | public 44 | constructor Create; override; 45 | end; 46 | 47 | 48 | implementation 49 | 50 | uses 51 | JcfStringUtils, 52 | SourceToken, Tokens, ParseTreeNodeType, FormatFlags; 53 | 54 | function CommentMustStay(const pc: TSourceToken): boolean; 55 | var 56 | lsPrefix: string; 57 | begin 58 | Result := False; 59 | 60 | lsPrefix := StrLeft(pc.SourceCode, 2); 61 | if (lsPrefix = '{$') or (lsPrefix = '{%') then 62 | Result := True; 63 | 64 | { all curly backets in the uses clause of a program/library def 65 | must be respected as they link files to dfms, com classes 'n stuff } 66 | if (pc.CommentStyle in CURLY_COMMENTS) and 67 | (pc.HasParentNode(TopOfProgramSections)) and pc.HasParentNode(UsesClauses) and 68 | pc.IsOnRightOf(UsesClauses, UsesWords) then 69 | Result := True; 70 | 71 | { these comments are flags to the code format program, so leave them } 72 | if (pc.SourceCode = '{(*}') or (pc.SourceCode = '{*)}') then 73 | Result := True; 74 | 75 | // these are also flags 76 | if ((pc.CommentStyle = eDoubleSlash) and 77 | (StrLeft(pc.SourceCode, FORMAT_COMMENT_PREFIX_LEN) = FORMAT_COMMENT_PREFIX)) then 78 | Result := True; 79 | 80 | end; 81 | 82 | constructor TRemoveComment.Create; 83 | begin 84 | inherited; 85 | FormatFlags := FormatFlags + [eObfuscate]; 86 | end; 87 | 88 | function TRemoveComment.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 89 | var 90 | lcSourceToken: TSourceToken; 91 | begin 92 | Result := False; 93 | lcSourceToken := TSourceToken(pcNode); 94 | 95 | (* turn comment to space - may be needed for token sep 96 | e.g. may be for a :=b{foo}to{bar}baz 97 | *) 98 | if lcSourceToken.TokenType = ttComment then 99 | begin 100 | if not CommentMustStay(lcSourceToken) then 101 | begin 102 | lcSourceToken.TokenType := ttWhiteSpace; 103 | lcSourceToken.SourceCode := ' '; 104 | end; 105 | end; 106 | end; 107 | 108 | end. 109 | -------------------------------------------------------------------------------- /Process/Obfuscate/RemoveConsecutiveWhiteSpace.pas: -------------------------------------------------------------------------------- 1 | unit RemoveConsecutiveWhiteSpace; 2 | 3 | { 4 | AFS 29 Dec 2002 5 | 6 | Visitor to remove consecutive whitespace 7 | Obfuscation 8 | } 9 | 10 | {(*} 11 | (*------------------------------------------------------------------------------ 12 | Delphi Code formatter source code 13 | 14 | The Original Code is RemoveConsecutiveWhiteSpace, released May 2003. 15 | The Initial Developer of the Original Code is Anthony Steele. 16 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 17 | All Rights Reserved. 18 | Contributor(s): Anthony Steele. 19 | 20 | The contents of this file are subject to the Mozilla Public License Version 1.1 21 | (the "License"). you may not use this file except in compliance with the License. 22 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 23 | 24 | Software distributed under the License is distributed on an "AS IS" basis, 25 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 26 | See the License for the specific language governing rights and limitations 27 | under the License. 28 | 29 | Alternatively, the contents of this file may be used under the terms of 30 | the GNU General Public License Version 2 or later (the "GPL") 31 | See http://www.gnu.org/licenses/gpl.html 32 | ------------------------------------------------------------------------------*) 33 | {*)} 34 | 35 | {$I JcfGlobal.inc} 36 | 37 | interface 38 | 39 | uses SwitchableVisitor; 40 | 41 | type 42 | TRemoveConsecutiveWhiteSpace = class(TSwitchableVisitor) 43 | private 44 | fbWhiteSpaceLast: boolean; 45 | protected 46 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 47 | public 48 | constructor Create; override; 49 | end; 50 | 51 | 52 | implementation 53 | 54 | uses SourceToken, Tokens, FormatFlags, TokenUtils; 55 | 56 | constructor TRemoveConsecutiveWhiteSpace.Create; 57 | begin 58 | inherited; 59 | FormatFlags := FormatFlags + [eObfuscate]; 60 | end; 61 | 62 | function TRemoveConsecutiveWhiteSpace.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 63 | var 64 | lcSourceToken: TSourceToken; 65 | begin 66 | Result := False; 67 | lcSourceToken := TSourceToken(pcNode); 68 | 69 | { delete whitespace if the last one was also whitespace } 70 | if (lcSourceToken.TokenType = ttWhiteSpace) and fbWhiteSpaceLast then 71 | BlankToken(lcSourceToken); 72 | 73 | fbWhiteSpaceLast := (lcSourceToken.TokenType = ttWhiteSpace); 74 | end; 75 | 76 | end. 77 | -------------------------------------------------------------------------------- /Process/Obfuscate/RemoveReturn.pas: -------------------------------------------------------------------------------- 1 | unit RemoveReturn; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is RemoveReturn, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses SwitchableVisitor; 33 | 34 | type 35 | TRemoveReturn = class(TSwitchableVisitor) 36 | protected 37 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 38 | public 39 | constructor Create; override; 40 | end; 41 | 42 | 43 | 44 | implementation 45 | 46 | uses SourceToken, Tokens, ParseTreeNodeType, FormatFlags; 47 | 48 | constructor TRemoveReturn.Create; 49 | begin 50 | inherited; 51 | FormatFlags := FormatFlags + [eObfuscate]; 52 | end; 53 | 54 | function TRemoveReturn.EnabledVisitSourceToken(const pcNode: TObject): boolean; 55 | var 56 | lcSourceToken, lcPrev: TSourceToken; 57 | begin 58 | Result := False; 59 | lcSourceToken := TSourceToken(pcNode); 60 | 61 | // only act on returns 62 | if lcSourceToken.TokenType <> ttReturn then 63 | exit; 64 | 65 | { not in asm } 66 | if lcSourceToken.HasParentNode(nAsm) then 67 | exit; 68 | 69 | // never remove the return after a comment like this 70 | lcPrev := lcSourceToken.PriorTokenWithExclusions([ttWhiteSpace]); 71 | 72 | if (lcPrev <> nil) and (lcPrev.TokenType = ttComment) and 73 | (lcPrev.CommentStyle = eDoubleSlash) then 74 | exit; 75 | 76 | // transmute to white space - may be needed as seperator 77 | lcSourceToken.SourceCode := ' '; 78 | lcSourceToken.TokenType := ttWhiteSpace; 79 | end; 80 | 81 | end. 82 | -------------------------------------------------------------------------------- /Process/Onceoffs/GlobalInclude.pas: -------------------------------------------------------------------------------- 1 | {(*} 2 | (*------------------------------------------------------------------------------ 3 | Delphi Code formatter source code 4 | 5 | The Original Code is GlobalInclude.pas, released May 2008. 6 | The Initial Developer of the Original Code is Anthony Steele. 7 | Portions created by Anthony Steele are Copyright (C) 2008 Anthony Steele. 8 | All Rights Reserved. 9 | Contributor(s): Anthony Steele. 10 | 11 | The contents of this file are subject to the Mozilla Public License Version 1.1 12 | (the "License"). you may not use this file except in compliance with the License. 13 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 14 | 15 | Software distributed under the License is distributed on an "AS IS" basis, 16 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 17 | See the License for the specific language governing rights and limitations 18 | under the License. 19 | 20 | Alternatively, the contents of this file may be used under the terms of 21 | the GNU General Public License Version 2 or later (the "GPL") 22 | See http://www.gnu.org/licenses/gpl.html 23 | ------------------------------------------------------------------------------*) 24 | {*)} 25 | 26 | unit GlobalInclude; 27 | 28 | { AFS 24 march 2K 29 | add in the global include 30 | } 31 | 32 | {$I JcfGlobal.inc} 33 | 34 | interface 35 | 36 | uses BaseVisitor, SourceToken; 37 | 38 | type 39 | TGlobalInclude = class(TBaseTreeNodeVisitor) 40 | private 41 | fbWorkIsDone: boolean; 42 | protected 43 | 44 | public 45 | constructor Create; override; 46 | 47 | function VisitSourceToken(const pcToken: TObject): Boolean; override; 48 | function IsIncludedInSettings: boolean; override; 49 | end; 50 | 51 | 52 | implementation 53 | 54 | uses 55 | { delphi }SysUtils, 56 | JclAnsiStrings, 57 | { local }Tokens, TokenUtils, JcfSettings, 58 | SettingsTypes, ParseTreeNodeType, SetClarify; 59 | 60 | 61 | const 62 | { this directive will be inserted in all files above the unit header } 63 | includeText = '{$I JcfGlobal.inc}' + AnsiLineBreak + AnsiLineBreak; 64 | 65 | function FirstOpportunityForInsert(const pt: TSourceToken): boolean; 66 | begin 67 | Result := False; 68 | 69 | if (pt.TokenType = ttInterface) and pt.HasParentNode(nUnit, 2) then 70 | begin 71 | // before interface in unit 72 | Result := True; 73 | end; 74 | end; 75 | 76 | 77 | constructor TGlobalInclude.Create; 78 | begin 79 | inherited; 80 | fbWorkIsDone := False; 81 | end; 82 | 83 | function TGlobalInclude.IsIncludedInSettings: boolean; 84 | begin 85 | Result := ( not FormatSettings.Obfuscate.Enabled) and 86 | (FormatSettings.Clarify.OnceOffs <> eDoNotRun) 87 | end; 88 | 89 | 90 | function TGlobalInclude.VisitSourceToken(const pcToken: TObject): Boolean; 91 | var 92 | lcToken, lcNewComment: TSourceToken; 93 | lbInContext: boolean; 94 | begin 95 | Result := False; 96 | if fbWorkIsDone then 97 | exit; 98 | 99 | lcToken := TSourceToken(pcToken); 100 | 101 | if (lcToken.TokenType = ttComment) and (Pos(includeText, lcToken.SourceCode) > 0) then 102 | begin 103 | fbWorkIsDone := True; 104 | exit; 105 | end; 106 | 107 | lbInContext := FirstOpportunityForInsert(lcToken); 108 | if not lbInContext then 109 | exit; 110 | 111 | // put the include in front of the unit start word 112 | lcNewComment := TSourceToken.Create; 113 | lcNewComment.TokenType := ttComment; 114 | lcNewComment.SourceCode := includeText; 115 | 116 | lcToken.Parent.InsertChild(lcToken.IndexOfSelf, lcNewComment); 117 | 118 | fbWorkIsDone := True; 119 | end; 120 | 121 | end. 122 | -------------------------------------------------------------------------------- /Process/RemoveEmptyComment.pas: -------------------------------------------------------------------------------- 1 | unit RemoveEmptyComment; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is RemoveEmptyComment, released Nov 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { AFS 9 Nov 2003 33 | Remove empty comments 34 | } 35 | 36 | uses SwitchableVisitor; 37 | 38 | type 39 | TRemoveEmptyComment = class(TSwitchableVisitor) 40 | private 41 | protected 42 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 43 | public 44 | constructor Create; override; 45 | 46 | function IsIncludedInSettings: boolean; override; 47 | end; 48 | 49 | 50 | implementation 51 | 52 | uses 53 | { system } 54 | SysUtils, 55 | { local } 56 | JcfStringUtils, 57 | FormatFlags, SourceToken, Tokens, TokenUtils, JcfSettings; 58 | 59 | 60 | constructor TRemoveEmptyComment.Create; 61 | begin 62 | inherited; 63 | FormatFlags := FormatFlags + [eRemoveComments]; 64 | end; 65 | 66 | function TRemoveEmptyComment.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 67 | var 68 | lcSourceToken: TSourceToken; 69 | lsCommentText: string; 70 | begin 71 | Result := False; 72 | lcSourceToken := TSourceToken(pcNode); 73 | 74 | case lcSourceToken.CommentStyle of 75 | eDoubleSlash: 76 | begin 77 | if FormatSettings.Comments.RemoveEmptyDoubleSlashComments then 78 | begin 79 | lsCommentText := StrAfter('//', lcSourceToken.SourceCode); 80 | lsCommentText := Trim(lsCommentText); 81 | if lsCommentText = '' then 82 | BlankToken(lcSourceToken); 83 | end; 84 | end; 85 | eCurlyBrace: 86 | begin 87 | if FormatSettings.Comments.RemoveEmptyCurlyBraceComments then 88 | begin 89 | lsCommentText := StrAfter('{', lcSourceToken.SourceCode); 90 | lsCommentText := StrBefore('}', lsCommentText); 91 | lsCommentText := Trim(lsCommentText); 92 | if lsCommentText = '' then 93 | BlankToken(lcSourceToken); 94 | end; 95 | end; 96 | eBracketStar, eCompilerDirective: ; // always leave these 97 | eNotAComment: ; // this is not a comment 98 | else 99 | // should not be here 100 | Assert(False); 101 | end; 102 | end; 103 | 104 | function TRemoveEmptyComment.IsIncludedInSettings: boolean; 105 | begin 106 | Result := FormatSettings.Comments.RemoveEmptyDoubleSlashComments or 107 | FormatSettings.Comments.RemoveEmptyCurlyBraceComments; 108 | end; 109 | 110 | end. 111 | -------------------------------------------------------------------------------- /Process/Returns/RemoveBlankLinesInVars.pas: -------------------------------------------------------------------------------- 1 | unit RemoveBlankLinesInVars; 2 | 3 | 4 | { AFS 9 March 2003 5 | At request, remove blank lines in procedure var declarations 6 | (and procedure const & type declarations) 7 | } 8 | 9 | {(*} 10 | (*------------------------------------------------------------------------------ 11 | Delphi Code formatter source code 12 | 13 | The Original Code is RemoveBlankLinesInVars, released May 2003. 14 | The Initial Developer of the Original Code is Anthony Steele. 15 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 16 | All Rights Reserved. 17 | Contributor(s): Anthony Steele. 18 | 19 | The contents of this file are subject to the Mozilla Public License Version 1.1 20 | (the "License"). you may not use this file except in compliance with the License. 21 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 22 | 23 | Software distributed under the License is distributed on an "AS IS" basis, 24 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 25 | See the License for the specific language governing rights and limitations 26 | under the License. 27 | 28 | Alternatively, the contents of this file may be used under the terms of 29 | the GNU General Public License Version 2 or later (the "GPL") 30 | See http://www.gnu.org/licenses/gpl.html 31 | ------------------------------------------------------------------------------*) 32 | {*)} 33 | 34 | {$I JcfGlobal.inc} 35 | 36 | interface 37 | 38 | uses SourceToken, SwitchableVisitor; 39 | 40 | type 41 | TRemoveBlankLinesInVars = class(TSwitchableVisitor) 42 | protected 43 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 44 | 45 | public 46 | constructor Create; override; 47 | 48 | function IsIncludedInSettings: boolean; override; 49 | end; 50 | 51 | implementation 52 | 53 | uses JcfSettings, FormatFlags, Tokens, TokenUtils; 54 | 55 | { TRemoveBlankLinesInVars } 56 | 57 | constructor TRemoveBlankLinesInVars.Create; 58 | begin 59 | inherited; 60 | FormatFlags := FormatFlags + [eRemoveReturn]; 61 | end; 62 | 63 | function TRemoveBlankLinesInVars.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 64 | var 65 | lcSourceToken: TSourceToken; 66 | lcNext: TSourceToken; 67 | lcTest: TSourceToken; 68 | liReturnCount: integer; 69 | liMaxReturns: integer; 70 | begin 71 | Result := False; 72 | lcSourceToken := TSourceToken(pcNode); 73 | 74 | if not InProcedureDeclarations(lcSourceToken) then 75 | exit; 76 | 77 | lcNext := lcSourceToken.NextTokenWithExclusions([ttWhiteSpace, ttReturn, ttComment]); 78 | 79 | if lcNext = nil then 80 | exit; 81 | 82 | { don't remove blank lines before the proc header, 83 | or before a contained fn or proc } 84 | if lcNext.TokenType in ProcedureWords then 85 | exit; 86 | 87 | lcNext := lcSourceToken.NextTokenWithExclusions([ttWhiteSpace, ttReturn]); 88 | liReturnCount := 0; 89 | liMaxReturns := FormatSettings.Returns.MaxBlankLinesInSection + 1; 90 | 91 | lcTest := lcSourceToken; 92 | 93 | { remove all returns up to that point (except one) } 94 | while (lcTest <> lcNext) do 95 | begin 96 | if (lcTest.TokenType = ttReturn) then 97 | begin 98 | // allow two returns -> 1 blank line 99 | Inc(liReturnCount); 100 | if (liReturnCount > liMaxReturns) then 101 | BlankToken(lcTest); 102 | 103 | end; 104 | lcTest := lcTest.NextToken; 105 | end; 106 | end; 107 | 108 | function TRemoveBlankLinesInVars.IsIncludedInSettings: boolean; 109 | begin 110 | Result := FormatSettings.Returns.RemoveVarReturns; 111 | end; 112 | 113 | end. 114 | -------------------------------------------------------------------------------- /Process/Returns/RemoveConsecutiveReturns.pas: -------------------------------------------------------------------------------- 1 | unit RemoveConsecutiveReturns; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is RemoveEmptyComment, released Nov 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { AFS 9 Nov 2003 33 | Remove consecutive returns 34 | ie put an upper limit on the number of blank lines in a row } 35 | 36 | uses SwitchableVisitor; 37 | 38 | type 39 | TRemoveConsecutiveReturns = class(TSwitchableVisitor) 40 | private 41 | protected 42 | function EnabledVisitSourceToken(const pcNode: TObject): boolean; override; 43 | public 44 | constructor Create; override; 45 | 46 | function IsIncludedInSettings: boolean; override; 47 | end; 48 | 49 | 50 | implementation 51 | 52 | uses 53 | { local } 54 | FormatFlags, SourceToken, Tokens, TokenUtils, JcfSettings; 55 | 56 | 57 | constructor TRemoveConsecutiveReturns.Create; 58 | begin 59 | inherited; 60 | FormatFlags := FormatFlags + [eRemoveReturn]; 61 | end; 62 | 63 | function TRemoveConsecutiveReturns.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 64 | var 65 | lcSourceToken: TSourceToken; 66 | liCount: integer; 67 | begin 68 | Result := False; 69 | lcSourceToken := TSourceToken(pcNode); 70 | 71 | liCount := 0; 72 | 73 | while (lcSourceToken <> nil) and (lcSourceToken.TokenType = ttReturn) do 74 | begin 75 | Inc(liCount); 76 | 77 | if (liCount - 1) > FormatSettings.Returns.MaxConsecutiveBlankLines then 78 | begin 79 | BlankToken(lcSourceToken); 80 | end; 81 | 82 | lcSourceToken := lcSourceToken.NextTokenWithExclusions([ttWhiteSpace]); 83 | end; 84 | 85 | end; 86 | 87 | function TRemoveConsecutiveReturns.IsIncludedInSettings: boolean; 88 | begin 89 | Result := FormatSettings.Returns.RemoveConsecutiveBlankLines; 90 | end; 91 | 92 | end. 93 | -------------------------------------------------------------------------------- /Process/Returns/RemoveReturnsAfterBegin.pas: -------------------------------------------------------------------------------- 1 | unit RemoveReturnsAfterBegin; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is RemoveReturnsAfterBegin, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses SourceToken, SwitchableVisitor; 33 | 34 | type 35 | TRemoveReturnsAfterBegin = class(TSwitchableVisitor) 36 | protected 37 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 38 | 39 | public 40 | constructor Create; override; 41 | 42 | function IsIncludedInSettings: boolean; override; 43 | end; 44 | 45 | implementation 46 | 47 | uses JcfSettings, Tokens, TokenUtils; 48 | 49 | { TRemoveReturnsAfterBegin } 50 | 51 | constructor TRemoveReturnsAfterBegin.Create; 52 | begin 53 | inherited; 54 | 55 | end; 56 | 57 | function TRemoveReturnsAfterBegin.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 58 | var 59 | lcSourceToken: TSourceToken; 60 | lcNext: TSourceToken; 61 | lcTest: TSourceToken; 62 | liReturnCount: integer; 63 | liMaxReturns: integer; 64 | begin 65 | Result := False; 66 | lcSourceToken := TSourceToken(pcNode); 67 | 68 | if lcSourceToken.TokenType <> ttBegin then 69 | exit; 70 | 71 | if not InStatements(lcSourceToken) then 72 | exit; 73 | 74 | lcNext := lcSourceToken.NextTokenWithExclusions([ttWhiteSpace, ttReturn]); 75 | 76 | liReturnCount := 0; 77 | liMaxReturns := 2; 78 | lcTest := lcSourceToken; 79 | 80 | { remove all returns up to that point (except one) } 81 | while (lcTest <> lcNext) do 82 | begin 83 | if (lcTest.TokenType = ttReturn) then 84 | begin 85 | // allow two returns -> 1 blank line 86 | Inc(liReturnCount); 87 | if (liReturnCount > liMaxReturns) then 88 | begin 89 | BlankToken(lcTest); 90 | end; 91 | end; 92 | lcTest := lcTest.NextToken; 93 | end; 94 | end; 95 | 96 | function TRemoveReturnsAfterBegin.IsIncludedInSettings: boolean; 97 | begin 98 | Result := FormatSettings.Returns.RemoveBlockBlankLines; 99 | end; 100 | 101 | end. 102 | -------------------------------------------------------------------------------- /Process/Returns/RemoveReturnsBeforeEnd.pas: -------------------------------------------------------------------------------- 1 | unit RemoveReturnsBeforeEnd; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is RemoveReturnsBeforeEnd, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses SourceToken, SwitchableVisitor; 33 | 34 | type 35 | TRemoveReturnsBeforeEnd = class(TSwitchableVisitor) 36 | protected 37 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 38 | 39 | public 40 | constructor Create; override; 41 | 42 | function IsIncludedInSettings: boolean; override; 43 | end; 44 | 45 | implementation 46 | 47 | uses JcfSettings, Tokens, TokenUtils; 48 | 49 | { TRemoveReturnsBeforeEnd } 50 | 51 | constructor TRemoveReturnsBeforeEnd.Create; 52 | begin 53 | inherited; 54 | end; 55 | 56 | function TRemoveReturnsBeforeEnd.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 57 | var 58 | lcSourceToken: TSourceToken; 59 | lcNext: TSourceToken; 60 | lcTest: TSourceToken; 61 | liReturnCount: integer; 62 | liMaxReturns: integer; 63 | begin 64 | Result := False; 65 | lcSourceToken := TSourceToken(pcNode); 66 | 67 | if lcSourceToken.TokenType <> ttReturn then 68 | exit; 69 | 70 | if not InStatements(lcSourceToken) then 71 | exit; 72 | 73 | lcNext := lcSourceToken.NextTokenWithExclusions([ttWhiteSpace, ttReturn]); 74 | 75 | if (lcNext = nil) or (lcNext.TokenType <> ttEnd) then 76 | exit; 77 | 78 | liReturnCount := 0; 79 | liMaxReturns := 2; 80 | lcTest := lcSourceToken; 81 | 82 | { remove all returns up to that point (except one) } 83 | while (lcTest <> lcNext) do 84 | begin 85 | if (lcTest.TokenType = ttReturn) then 86 | begin 87 | // allow two returns -> 1 blank line 88 | Inc(liReturnCount); 89 | if (liReturnCount > liMaxReturns) then 90 | begin 91 | BlankToken(lcTest); 92 | end; 93 | end; 94 | lcTest := lcTest.NextToken; 95 | end; 96 | end; 97 | 98 | function TRemoveReturnsBeforeEnd.IsIncludedInSettings: boolean; 99 | begin 100 | Result := FormatSettings.Returns.RemoveBlockBlankLines; 101 | end; 102 | 103 | end. 104 | -------------------------------------------------------------------------------- /Process/Returns/ReturnChars.pas: -------------------------------------------------------------------------------- 1 | unit ReturnChars; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is ReturnChars, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses SourceToken, SwitchableVisitor; 33 | 34 | type 35 | TReturnChars = class(TSwitchableVisitor) 36 | protected 37 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 38 | 39 | public 40 | constructor Create; override; 41 | 42 | function IsIncludedInSettings: boolean; override; 43 | end; 44 | 45 | implementation 46 | 47 | uses 48 | { local } 49 | JcfStringUtils, 50 | Tokens, SettingsTypes, 51 | JcfSettings; 52 | 53 | { TReturnChars } 54 | 55 | constructor TReturnChars.Create; 56 | begin 57 | inherited; 58 | 59 | end; 60 | 61 | function TReturnChars.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 62 | var 63 | lcSourceToken: TSourceToken; 64 | begin 65 | Result := False; 66 | lcSourceToken := TSourceToken(pcNode); 67 | 68 | if (lcSourceToken.TokenType <> ttReturn) then 69 | exit; 70 | 71 | case FormatSettings.Returns.ReturnChars of 72 | rcLeaveAsIs: 73 | begin 74 | // leave as is 75 | end; 76 | rcLinefeed: 77 | begin 78 | // easy case - CrLf with Lf 79 | lcSourceToken.SourceCode := NativeLineFeed; 80 | end; 81 | rcCrLf: 82 | begin 83 | lcSourceToken.SourceCode := NativeCrLf; 84 | end; 85 | rcPlatform: 86 | begin 87 | // AnsiLineBreak is set to the right value at compile time 88 | lcSourceToken.SourceCode := NativeLineBreak; 89 | end; 90 | 91 | end; 92 | end; 93 | 94 | function TReturnChars.IsIncludedInSettings: boolean; 95 | begin 96 | Result := (FormatSettings.Returns.ReturnChars <> rcLeaveAsIs); 97 | end; 98 | 99 | end. 100 | -------------------------------------------------------------------------------- /Process/Returns/ReturnsAfterFinalEnd.pas: -------------------------------------------------------------------------------- 1 | unit ReturnsAfterFinalEnd; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is ReturnsAfterFinalEnd.pas, released September 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { AFS 27 Sept 2003 33 | process to standardise the number of returns 34 | after the final "end." of the unit } 35 | 36 | uses SwitchableVisitor; 37 | 38 | type 39 | TReturnsAfterFinalEnd = class(TSwitchableVisitor) 40 | private 41 | protected 42 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 43 | public 44 | constructor Create; override; 45 | 46 | end; 47 | 48 | 49 | implementation 50 | 51 | uses 52 | JcfSettings, 53 | SourceToken, FormatFlags, Tokens, ParseTreeNodeType, TokenUtils; 54 | 55 | { TReturnsAfterFinalEnd } 56 | 57 | constructor TReturnsAfterFinalEnd.Create; 58 | begin 59 | inherited; 60 | FormatFlags := FormatFlags + [eAddReturn, eRemoveReturn]; 61 | end; 62 | 63 | function TReturnsAfterFinalEnd.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 64 | var 65 | lcSourceToken: TSourceToken; 66 | lcCurrent, lcPrev: TSourceToken; 67 | liReturnsWanted, liReturnsFound: integer; 68 | begin 69 | Result := False; 70 | lcSourceToken := TSourceToken(pcNode); 71 | 72 | if (lcSourceToken.TokenType = ttDot) and 73 | (lcSourceToken.HasParentNode(TopOfFileSection, 1)) then 74 | begin 75 | // count the returns 76 | lcCurrent := lcSourceToken; 77 | liReturnsWanted := FormatSettings.Returns.NumReturnsAfterFinalEnd; 78 | liReturnsFound := 0; 79 | 80 | while lcCurrent <> nil do 81 | begin 82 | if lcCurrent.TokenType = ttReturn then 83 | begin 84 | Inc(liReturnsFound); 85 | 86 | lcPrev := lcCurrent.PriorToken; 87 | 88 | if (liReturnsFound > liReturnsWanted) and ( not lcPrev.IsSolid) then 89 | begin 90 | { this returns is surplus - remove it } 91 | BlankToken(lcCurrent); 92 | end; 93 | end; 94 | 95 | lcCurrent := lcCurrent.NextToken; 96 | end; 97 | 98 | { need to insert some returns? } 99 | while liReturnsFound < liReturnsWanted do 100 | begin 101 | InsertReturnAfter(lcSourceToken); 102 | Inc(liReturnsFound); 103 | end; 104 | end; 105 | end; 106 | 107 | end. 108 | -------------------------------------------------------------------------------- /Process/Spacing/MaxSpaces.pas: -------------------------------------------------------------------------------- 1 | unit MaxSpaces; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is MaxSpaces, released January 2004. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { AFS 4 Jan 2002 33 | convert spaces tabs } 34 | 35 | uses SwitchableVisitor; 36 | 37 | type 38 | TMaxSpaces = class(TSwitchableVisitor) 39 | private 40 | fsSpaces: string; 41 | 42 | protected 43 | function EnabledVisitSourceToken(const pcNode: TObject): boolean; override; 44 | public 45 | constructor Create; override; 46 | 47 | function IsIncludedInSettings: boolean; override; 48 | end; 49 | 50 | implementation 51 | 52 | uses 53 | { local } 54 | JcfStringUtils, 55 | JcfSettings, SourceToken, Tokens, 56 | FormatFlags, ParseTreeNodeType; 57 | 58 | constructor TMaxSpaces.Create; 59 | begin 60 | inherited; 61 | fsSpaces := StrRepeat(NativeSpace, FormatSettings.Spaces.MaxSpacesInCode); 62 | FormatFlags := FormatFlags + [eRemoveSpace]; 63 | end; 64 | 65 | function TMaxSpaces.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 66 | var 67 | lcSourceToken, lcNext: TSourceToken; 68 | begin 69 | Result := False; 70 | lcSourceToken := TSourceToken(pcNode); 71 | 72 | { only look at white space } 73 | if (lcSourceToken.TokenType <> ttWhiteSpace) then 74 | exit; 75 | 76 | { not in asm blocks } 77 | if lcSourceToken.HasParentNode(nAsm) then 78 | exit; 79 | 80 | { not before comments } 81 | lcNext := lcSourceToken.NextToken; 82 | if (lcNext <> nil) and (lcNext.TokenType = ttComment) then 83 | exit; 84 | 85 | { don't truncate the indentation spaces } 86 | if lcSourceToken.SolidTokenOnLineIndex > 0 then 87 | begin 88 | { if the token is too long, truncate it } 89 | if Length(lcSourceToken.SourceCode) > FormatSettings.Spaces.MaxSpacesInCode then 90 | begin 91 | lcSourceToken.SourceCode := fsSpaces; 92 | end; 93 | end; 94 | end; 95 | 96 | function TMaxSpaces.IsIncludedInSettings: boolean; 97 | begin 98 | Result := FormatSettings.Spaces.UseMaxSpacesInCode; 99 | end; 100 | 101 | end. 102 | -------------------------------------------------------------------------------- /Process/Spacing/MoveSpaceToBeforeColon.pas: -------------------------------------------------------------------------------- 1 | unit MoveSpaceToBeforeColon; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter MoveSpaceToBeforeColon code 6 | 7 | The Original Code is SingleSpaceAfter, released December 2008. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { AFS 14 December 2009 33 | Process to move spaces to after colon 34 | SF Bug request #2173842 35 | } 36 | 37 | uses SwitchableVisitor; 38 | 39 | type 40 | TMoveSpaceToBeforeColon = class(TSwitchableVisitor) 41 | private 42 | protected 43 | function EnabledVisitSourceToken(const pcNode: TObject): boolean; override; 44 | public 45 | constructor Create; override; 46 | 47 | function IsIncludedInSettings: boolean; override; 48 | end; 49 | 50 | 51 | implementation 52 | 53 | uses 54 | FormatFlags, SourceToken, Tokens, TokenUtils, JcfSettings; 55 | 56 | constructor TMoveSpaceToBeforeColon.Create; 57 | begin 58 | inherited; 59 | FormatFlags := FormatFlags + [eAddSpace, eRemoveSpace, eRemoveReturn]; 60 | end; 61 | 62 | function TMoveSpaceToBeforeColon.EnabledVisitSourceToken(const pcNode: TObject): boolean; 63 | var 64 | lcSourceToken: TSourceToken; 65 | lcNext: TSourceToken; 66 | lcAfter: TSourceToken; 67 | lcNew: TSourceToken; 68 | begin 69 | Result := False; 70 | lcSourceToken := TSourceToken(pcNode); 71 | 72 | if lcSourceToken.TokenType = ttColon then 73 | begin 74 | lcNext := lcSourceToken.NextToken; 75 | 76 | if (lcNext <> nil) and (lcNext.TokenType = ttWhiteSpace) and 77 | (Length(lcNext.SourceCode) > 0) then 78 | begin 79 | // put the space before 80 | lcNew := TSourceToken.Create; 81 | lcNew.TokenType := ttWhiteSpace; 82 | lcNew.SourceCode := lcNext.SourceCode; 83 | 84 | BlankToken(lcNext); 85 | 86 | // and any following space 87 | lcAfter := lcNext.NextToken; 88 | while (lcAfter <> nil) and (lcAfter.TokenType = ttWhiteSpace) do 89 | begin 90 | lcNew.SourceCode := lcNew.SourceCode + lcAfter.SourceCode; 91 | BlankToken(lcAfter); 92 | lcAfter := lcAfter.NextToken; 93 | end; 94 | 95 | InsertTokenBefore(lcSourceToken, lcNew); 96 | 97 | Result := True; 98 | end; 99 | 100 | end; 101 | end; 102 | 103 | function TMoveSpaceToBeforeColon.IsIncludedInSettings: boolean; 104 | begin 105 | Result := FormatSettings.Spaces.MoveSpaceToBeforeColon; 106 | end; 107 | 108 | end. 109 | -------------------------------------------------------------------------------- /Process/Spacing/RemoveSpaceAtLineEnd.pas: -------------------------------------------------------------------------------- 1 | unit RemoveSpaceAtLineEnd; 2 | 3 | { AFS 10 May 2003 4 | remove trainling spaces on lines 5 | makes test fail, false delta } 6 | 7 | {(*} 8 | (*------------------------------------------------------------------------------ 9 | Delphi Code formatter source code 10 | 11 | The Original Code is RemoveSpaceAtLineEnd, released May 2003. 12 | The Initial Developer of the Original Code is Anthony Steele. 13 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 14 | All Rights Reserved. 15 | Contributor(s): Anthony Steele. 16 | 17 | The contents of this file are subject to the Mozilla Public License Version 1.1 18 | (the "License"). you may not use this file except in compliance with the License. 19 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 20 | 21 | Software distributed under the License is distributed on an "AS IS" basis, 22 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 23 | See the License for the specific language governing rights and limitations 24 | under the License. 25 | 26 | Alternatively, the contents of this file may be used under the terms of 27 | the GNU General Public License Version 2 or later (the "GPL") 28 | See http://www.gnu.org/licenses/gpl.html 29 | ------------------------------------------------------------------------------*) 30 | {*)} 31 | 32 | {$I JcfGlobal.inc} 33 | 34 | interface 35 | 36 | uses SwitchableVisitor; 37 | 38 | type 39 | TRemoveSpaceAtLineEnd = class(TSwitchableVisitor) 40 | private 41 | protected 42 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 43 | public 44 | constructor Create; override; 45 | 46 | function IsIncludedInSettings: boolean; override; 47 | end; 48 | 49 | 50 | 51 | implementation 52 | 53 | uses JcfSettings, FormatFlags, SourceToken, Tokens, TokenUtils; 54 | 55 | 56 | constructor TRemoveSpaceAtLineEnd.Create; 57 | begin 58 | inherited; 59 | FormatFlags := FormatFlags + [eRemoveSpace]; 60 | end; 61 | 62 | function TRemoveSpaceAtLineEnd.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 63 | var 64 | lcSourceToken, lcNext: TSourceToken; 65 | begin 66 | Result := False; 67 | lcSourceToken := TSourceToken(pcNode); 68 | 69 | { is this white space? } 70 | if lcSourceToken.TokenType = ttWhiteSpace then 71 | begin 72 | { is a return next ? } 73 | lcNext := lcSourceToken.NextTokenWithExclusions([ttWhiteSpace]); 74 | if (lcNext <> nil) and (lcNext.TokenType = ttReturn) then 75 | begin 76 | BlankToken(lcSourceToken); 77 | end; 78 | end; 79 | 80 | end; 81 | 82 | function TRemoveSpaceAtLineEnd.IsIncludedInSettings: boolean; 83 | begin 84 | Result := FormatSettings.Spaces.FixSpacing; 85 | end; 86 | 87 | end. 88 | -------------------------------------------------------------------------------- /Process/Spacing/SpaceToTab.pas: -------------------------------------------------------------------------------- 1 | unit SpaceToTab; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is SpaceToTab, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { AFS 4 Jan 2002 33 | convert spaces tabs } 34 | 35 | uses SwitchableVisitor; 36 | 37 | type 38 | TSpaceToTab = class(TSwitchableVisitor) 39 | private 40 | fsSpaces: string; 41 | 42 | protected 43 | function EnabledVisitSourceToken(const pcNode: TObject): boolean; override; 44 | public 45 | constructor Create; override; 46 | 47 | function IsIncludedInSettings: boolean; override; 48 | end; 49 | 50 | implementation 51 | 52 | uses 53 | SysUtils, 54 | { local } 55 | JcfStringUtils, 56 | JcfSettings, SourceToken, Tokens, FormatFlags; 57 | 58 | constructor TSpaceToTab.Create; 59 | begin 60 | inherited; 61 | fsSpaces := string(StrRepeat(NativeSpace, FormatSettings.Spaces.SpacesForTab)); 62 | FormatFlags := FormatFlags + [eAddSpace, eRemoveSpace]; 63 | end; 64 | 65 | function TSpaceToTab.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 66 | var 67 | lcSourceToken, lcNextToken: TSourceToken; 68 | ls, lsTab: string; 69 | begin 70 | Result := False; 71 | lcSourceToken := TSourceToken(pcNode); 72 | 73 | { work only on whitespace tokens. 74 | Indent spaces also occur in multiline comments, but leave them alone } 75 | if (lcSourceToken.TokenType <> ttWhiteSpace) then 76 | exit; 77 | 78 | { Merge following space tokens 79 | can't pass property as var parameter so ls local var is used } 80 | 81 | ls := lcSourceToken.SourceCode; 82 | lcNextToken := lcSourceToken.NextToken; 83 | while (lcNextToken <> nil) and (lcNextToken.TokenType = ttWhiteSpace) do 84 | begin 85 | ls := ls + lcNextToken.SourceCode; 86 | lcNextToken.SourceCode := ''; 87 | lcNextToken := lcNextToken.NextToken; 88 | end; 89 | 90 | lsTab := NativeTab; 91 | StrReplace(ls, fsSpaces, lsTab, [rfReplaceAll]); 92 | lcSourceToken.SourceCode := ls; 93 | end; 94 | 95 | function TSpaceToTab.IsIncludedInSettings: boolean; 96 | begin 97 | Result := FormatSettings.Spaces.SpacesToTabs; 98 | end; 99 | 100 | end. 101 | -------------------------------------------------------------------------------- /Process/Spacing/TabToSpace.pas: -------------------------------------------------------------------------------- 1 | unit TabToSpace; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is TabToSpace, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { AFS 4 Jan 2002 33 | convert tabs to spaces } 34 | 35 | uses SwitchableVisitor; 36 | 37 | type 38 | TTabToSpace = class(TSwitchableVisitor) 39 | private 40 | fsSpaces: string; 41 | 42 | protected 43 | function EnabledVisitSourceToken(const pcNode: TObject): boolean; override; 44 | public 45 | constructor Create; override; 46 | 47 | function IsIncludedInSettings: boolean; override; 48 | end; 49 | 50 | 51 | implementation 52 | 53 | uses 54 | { Delphi } 55 | SysUtils, 56 | { local } 57 | JcfStringUtils, 58 | JcfSettings, SourceToken, Tokens, FormatFlags; 59 | 60 | constructor TTabToSpace.Create; 61 | begin 62 | inherited; 63 | fsSpaces := StrRepeat(NativeSpace, FormatSettings.Spaces.SpacesPerTab); 64 | FormatFlags := FormatFlags + [eAddSpace, eRemoveSpace]; 65 | end; 66 | 67 | function TTabToSpace.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 68 | var 69 | lcSourceToken, lcNextToken: TSourceToken; 70 | ls: String; 71 | begin 72 | Result := False; 73 | lcSourceToken := TSourceToken(pcNode); 74 | 75 | if not (lcSourceToken.TokenType in [ttWhiteSpace, ttComment]) then 76 | exit; 77 | 78 | { can't pass property as var parameter so ls local var is used 79 | Must keep it wide to preserve unicode chars in comments } 80 | ls := lcSourceToken.SourceCode; 81 | 82 | { merge any following whitespace tokens with a whitespace } 83 | if (lcSourceToken.TokenType = ttWhiteSpace) then 84 | begin 85 | lcNextToken := lcSourceToken.NextToken; 86 | while (lcNextToken <> nil) and (lcNextToken.TokenType = ttWhiteSpace) do 87 | begin 88 | ls := ls + lcNextToken.SourceCode; 89 | lcNextToken.SourceCode := ''; 90 | lcNextToken := lcNextToken.NextToken; 91 | end; 92 | end; 93 | 94 | ls := StringReplace(ls, NativeTab, fsSpaces, [rfReplaceAll]); 95 | lcSourceToken.SourceCode := ls; 96 | end; 97 | 98 | function TTabToSpace.IsIncludedInSettings: boolean; 99 | begin 100 | Result := FormatSettings.Spaces.TabsToSpaces; 101 | end; 102 | 103 | end. 104 | -------------------------------------------------------------------------------- /Process/Transform/AddBlockEndSemicolon.pas: -------------------------------------------------------------------------------- 1 | unit AddBlockEndSemicolon; 2 | {(*} 3 | (*------------------------------------------------------------------------------ 4 | Delphi Code formatter source code 5 | 6 | The Original Code is AddBlockEndSemicolon.pas, March 2004. 7 | The Initial Developer of the Original Code is Anthony Steele. 8 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 9 | All Rights Reserved. 10 | Contributor(s): Anthony Steele. 11 | 12 | The contents of this file are subject to the Mozilla Public License Version 1.1 13 | (the "License"). you may not use this file except in compliance with the License. 14 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 15 | 16 | Software distributed under the License is distributed on an "AS IS" basis, 17 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 18 | See the License for the specific language governing rights and limitations 19 | under the License. 20 | 21 | Alternatively, the contents of this file may be used under the terms of 22 | the GNU General Public License Version 2 or later (the "GPL") 23 | See http://www.gnu.org/licenses/gpl.html 24 | ------------------------------------------------------------------------------*) 25 | {*)} 26 | 27 | {$I JcfGlobal.inc} 28 | 29 | interface 30 | 31 | uses BaseVisitor; 32 | 33 | type 34 | TBlockEndSemicolon = class(TBaseTreeNodeVisitor) 35 | private 36 | 37 | protected 38 | public 39 | constructor Create; override; 40 | 41 | procedure PostVisitParseTreeNode(const pcNode: TObject); override; 42 | function IsIncludedInSettings: boolean; override; 43 | end; 44 | 45 | implementation 46 | 47 | uses ParseTreeNode, ParseTreeNodeType, 48 | JcfSettings, SourceToken, Tokens, TokenUtils; 49 | 50 | constructor TBlockEndSemicolon.Create; 51 | begin 52 | inherited; 53 | 54 | HasPostVisit := True; 55 | HasSourceTokenVisit := False; 56 | end; 57 | 58 | procedure TBlockEndSemicolon.PostVisitParseTreeNode(const pcNode: TObject); 59 | var 60 | lcNode: TParseTreeNode; 61 | lcStatementList: TParseTreeNode; 62 | lcEnd: TSourceToken; 63 | lcNew: TSourceToken; 64 | begin 65 | lcNode := TParseTreeNode(pcNode); 66 | 67 | { looking for a compound statement with begin..end } 68 | if lcNode.NodeType <> nCompoundStatement then 69 | exit; 70 | if not lcNode.HasChildNode(ttBegin, 1) then 71 | exit; 72 | if not lcNode.HasChildNode(ttEnd, 1) then 73 | exit; 74 | 75 | { extract the statement list between the begin & end } 76 | lcStatementList := lcNode.GetImmediateChild(nStatementList); 77 | if lcStatementList = nil then 78 | exit; 79 | 80 | { what's the last source token in this block ? } 81 | lcEnd := TSourceToken(lcStatementList.LastLeaf); 82 | if lcEnd = nil then 83 | exit; 84 | 85 | if not lcEnd.IsSolid then 86 | lcEnd := lcEnd.PriorSolidToken; 87 | 88 | if lcEnd.TokenType <> ttSemiColon then 89 | begin 90 | lcNew := TSourceToken.Create; 91 | lcNew.SourceCode := ';'; 92 | lcNew.TokenType := ttSemiColon; 93 | 94 | InsertTokenAfter(lcEnd, lcNew); 95 | end; 96 | end; 97 | 98 | 99 | function TBlockEndSemicolon.IsIncludedInSettings: boolean; 100 | begin 101 | Result := FormatSettings.Transform.AddBlockEndSemiColon; 102 | end; 103 | 104 | end. 105 | -------------------------------------------------------------------------------- /Process/Transform/FindReplace.pas: -------------------------------------------------------------------------------- 1 | unit FindReplace; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is FindReplace.pas, released April 2000. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses SwitchableVisitor; 33 | 34 | type 35 | TFindReplace = class(TSwitchableVisitor) 36 | private 37 | fiCount: integer; 38 | 39 | protected 40 | function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override; 41 | public 42 | constructor Create; override; 43 | 44 | function IsIncludedInSettings: boolean; override; 45 | function FinalSummary(out psMessage: string): boolean; override; 46 | 47 | end; 48 | 49 | implementation 50 | 51 | uses 52 | { delphi } 53 | SysUtils, 54 | { local } 55 | JcfSettings, 56 | SourceToken, 57 | FormatFlags; 58 | 59 | { TFindReplace } 60 | 61 | constructor TFindReplace.Create; 62 | begin 63 | inherited; 64 | fiCount := 0; 65 | 66 | FormatFlags := FormatFlags + [eFindReplace]; 67 | end; 68 | 69 | function TFindReplace.IsIncludedInSettings: boolean; 70 | begin 71 | Result := FormatSettings.Replace.Enabled; 72 | end; 73 | 74 | function TFindReplace.FinalSummary(out psMessage: string): boolean; 75 | begin 76 | Result := (fiCount > 0); 77 | if Result then 78 | begin 79 | psMessage := 'Replace: ' + IntToStr(fiCount) + ' changes were made'; 80 | end 81 | else 82 | begin 83 | psMessage := ''; 84 | end; 85 | end; 86 | 87 | 88 | function TFindReplace.EnabledVisitSourceToken(const pcNode: TObject): Boolean; 89 | var 90 | lcSourceToken: TSourceToken; 91 | begin 92 | Result := False; 93 | 94 | if pcNode = nil then 95 | exit; 96 | lcSourceToken := TSourceToken(pcNode); 97 | 98 | if lcSourceToken.SourceCode = '' then 99 | exit; 100 | 101 | if not FormatSettings.Replace.HasWord(lcSourceToken.SourceCode) then 102 | exit; 103 | 104 | lcSourceToken.SourceCode := FormatSettings.Replace.Replace(lcSourceToken.SourceCode); 105 | Inc(fiCount); 106 | end; 107 | 108 | end. 109 | -------------------------------------------------------------------------------- /Process/VisitSetXY.pas: -------------------------------------------------------------------------------- 1 | unit VisitSetXY; 2 | 3 | { A visitor to set the X and Y coordinates of each token 4 | based on keeping a running count of the text length and number of newlines } 5 | 6 | {(*} 7 | (*------------------------------------------------------------------------------ 8 | Delphi Code formatter source code 9 | 10 | The Original Code is VisitSetXY, released May 2003. 11 | The Initial Developer of the Original Code is Anthony Steele. 12 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 13 | All Rights Reserved. 14 | Contributor(s): Anthony Steele. 15 | 16 | The contents of this file are subject to the Mozilla Public License Version 1.1 17 | (the "License"). you may not use this file except in compliance with the License. 18 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 19 | 20 | Software distributed under the License is distributed on an "AS IS" basis, 21 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 22 | See the License for the specific language governing rights and limitations 23 | under the License. 24 | 25 | Alternatively, the contents of this file may be used under the terms of 26 | the GNU General Public License Version 2 or later (the "GPL") 27 | See http://www.gnu.org/licenses/gpl.html 28 | ------------------------------------------------------------------------------*) 29 | {*)} 30 | 31 | {$I JcfGlobal.inc} 32 | 33 | interface 34 | 35 | uses BaseVisitor; 36 | 37 | type 38 | TVisitSetXY = class(TBaseTreeNodeVisitor) 39 | private 40 | // running totals of x and Y pos, and count of solid tokens on the line 41 | fiX, fiY, fiSolidTokenOnLineIndex: integer; 42 | fsFileName: string; 43 | public 44 | constructor Create; override; 45 | 46 | function VisitSourceToken(const pcToken: TObject): Boolean; override; 47 | end; 48 | 49 | implementation 50 | 51 | uses 52 | { local } 53 | JcfStringUtils, 54 | JcfMiscFunctions, SourceToken, Tokens; 55 | 56 | constructor TVisitSetXY.Create; 57 | begin 58 | inherited; 59 | 60 | // text coords start at 1,1 61 | fiX := 1; 62 | fiY := 1; 63 | fiSolidTokenOnLineIndex := 0; 64 | fsFileName := ''; 65 | end; 66 | 67 | function TVisitSetXY.VisitSourceToken(const pcToken: TObject): boolean; 68 | var 69 | lcToken: TSourceToken; 70 | begin 71 | Result := False; 72 | lcToken := TSourceToken(pcToken); 73 | 74 | // track the file name 75 | if (fsFileName = '') and (lcToken.FileName <> '') then 76 | begin 77 | fsFileName := lcToken.FileName; 78 | end; 79 | 80 | // apply file name to all tokens that don't have it 81 | if lcToken.FileName = '' then 82 | begin 83 | lcToken.FileName := fsFileName; 84 | end; 85 | 86 | 87 | 88 | // track position 89 | lcToken.XPosition := fiX; 90 | lcToken.YPosition := fiY; 91 | lcToken.SolidTokenOnLineIndex := fiSolidTokenOnLineIndex; 92 | 93 | if lcToken.TokenType = ttReturn then 94 | fiSolidTokenOnLineIndex := 0 95 | else if (lcToken.TokenType = ttComment) and 96 | (Pos(NativeLineBreak, string(lcToken.SourceCode)) > 0) then 97 | fiSolidTokenOnLineIndex := 0 98 | else if lcToken.IsSolid then 99 | Inc(fiSolidTokenOnLineIndex); 100 | 101 | // keep count 102 | AdvanceTextPos(lcToken.SourceCode, fiX, fiY); 103 | end; 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /Process/VisitStripEmptySpace.pas: -------------------------------------------------------------------------------- 1 | unit VisitStripEmptySpace; 2 | 3 | { AFS 7 March 2003 4 | needed after SpaceBeforeColon 5 | It is possible that some tokens will be spaces 6 | with sourcecode = '' null/empty string 7 | discared these 8 | } 9 | 10 | {(*} 11 | (*------------------------------------------------------------------------------ 12 | Delphi Code formatter source code 13 | 14 | The Original Code is VisitStripEmptySpace, released May 2003. 15 | The Initial Developer of the Original Code is Anthony Steele. 16 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 17 | All Rights Reserved. 18 | Contributor(s): Anthony Steele. 19 | 20 | The contents of this file are subject to the Mozilla Public License Version 1.1 21 | (the "License"). you may not use this file except in compliance with the License. 22 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 23 | 24 | Software distributed under the License is distributed on an "AS IS" basis, 25 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 26 | See the License for the specific language governing rights and limitations 27 | under the License. 28 | 29 | Alternatively, the contents of this file may be used under the terms of 30 | the GNU General Public License Version 2 or later (the "GPL") 31 | See http://www.gnu.org/licenses/gpl.html 32 | ------------------------------------------------------------------------------*) 33 | {*)} 34 | 35 | {$I JcfGlobal.inc} 36 | 37 | interface 38 | 39 | uses BaseVisitor; 40 | 41 | type 42 | TVisitStripEmptySpace = class(TBaseTreeNodeVisitor) 43 | public 44 | function VisitSourceToken(const pcToken: TObject): Boolean; override; 45 | end; 46 | 47 | implementation 48 | 49 | uses SourceToken, Tokens; 50 | 51 | function TVisitStripEmptySpace.VisitSourceToken(const pcToken: TObject): Boolean; 52 | var 53 | lcSourceToken, lcNext: TSourceToken; 54 | begin 55 | Result := False; 56 | lcSourceToken := TSourceToken(pcToken); 57 | 58 | if (lcSourceToken <> nil) and (lcSourceToken.TokenType = ttWhiteSpace) then 59 | begin 60 | { remove } 61 | if (lcSourceToken.SourceCode = '') then 62 | begin 63 | lcSourceToken.Free; 64 | Result := True; 65 | end 66 | else 67 | begin 68 | lcNext := lcSourceToken.NextToken; 69 | { consolidate } 70 | if (lcNext <> nil) and (lcNext.TokenType = ttWhiteSpace) then 71 | begin 72 | lcNext.SourceCode := lcNext.SourceCode + lcSourceToken.SourceCode; 73 | lcSourceToken.Free; 74 | Result := True; 75 | end; 76 | end; 77 | end; 78 | end; 79 | 80 | end. 81 | -------------------------------------------------------------------------------- /Process/Warnings/WarnCaseNoElse.pas: -------------------------------------------------------------------------------- 1 | unit WarnCaseNoElse; 2 | 3 | { AFS 20 June 2K 4 | warn of case without a default 'else' case 5 | 6 | This is often an error 7 | your program will be more error-proof if every case has an else 8 | if you can't think of anything to put there, put 9 | 10 | case 11 | ... 12 | else Raise Exception.Create('case had unexpected value'); 13 | end; 14 | } 15 | 16 | {(*} 17 | (*------------------------------------------------------------------------------ 18 | Delphi Code formatter source code 19 | 20 | The Original Code is WarnCaseNoElse, released May 2003. 21 | The Initial Developer of the Original Code is Anthony Steele. 22 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 23 | All Rights Reserved. 24 | Contributor(s): Anthony Steele. 25 | 26 | The contents of this file are subject to the Mozilla Public License Version 1.1 27 | (the "License"). you may not use this file except in compliance with the License. 28 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 29 | 30 | Software distributed under the License is distributed on an "AS IS" basis, 31 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 32 | See the License for the specific language governing rights and limitations 33 | under the License. 34 | 35 | Alternatively, the contents of this file may be used under the terms of 36 | the GNU General Public License Version 2 or later (the "GPL") 37 | See http://www.gnu.org/licenses/gpl.html 38 | ------------------------------------------------------------------------------*) 39 | {*)} 40 | 41 | {$I JcfGlobal.inc} 42 | 43 | interface 44 | 45 | uses Warning; 46 | 47 | type 48 | 49 | TWarnCaseNoElse = class(TWarning) 50 | public 51 | constructor Create; override; 52 | 53 | procedure PreVisitParseTreeNode(const pcNode: TObject); override; 54 | end; 55 | 56 | 57 | implementation 58 | 59 | uses 60 | ParseTreeNode, ParseTreeNodeType; 61 | 62 | 63 | 64 | constructor TWarnCaseNoElse.Create; 65 | begin 66 | inherited; 67 | 68 | HasPreVisit := True; 69 | HasPostVisit := False; 70 | HasSourceTokenVisit := True; 71 | end; 72 | 73 | procedure TWarnCaseNoElse.PreVisitParseTreeNode(const pcNode: TObject); 74 | var 75 | lcNode: TParseTreeNode; 76 | begin 77 | lcNode := TParseTreeNode(pcNode); 78 | 79 | // when we have a case statement, does it have an else? 80 | if (lcNode.NodeType = nCaseStatement) and 81 | ( not lcNode.HasChildNode(nElseCase, 1)) then 82 | begin 83 | SendWarning(lcNode, 'Case statement has no else case'); 84 | end; 85 | end; 86 | 87 | end. 88 | -------------------------------------------------------------------------------- /Process/Warnings/WarnDestroy.pas: -------------------------------------------------------------------------------- 1 | unit WarnDestroy; 2 | 3 | { AFS 30 December 2002 4 | 5 | warn of calls to obj.destroy; 6 | } 7 | 8 | 9 | {(*} 10 | (*------------------------------------------------------------------------------ 11 | Delphi Code formatter source code 12 | 13 | The Original Code is WarnDestroy, released May 2003. 14 | The Initial Developer of the Original Code is Anthony Steele. 15 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 16 | All Rights Reserved. 17 | Contributor(s): Anthony Steele. 18 | 19 | The contents of this file are subject to the Mozilla Public License Version 1.1 20 | (the "License"). you may not use this file except in compliance with the License. 21 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 22 | 23 | Software distributed under the License is distributed on an "AS IS" basis, 24 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 25 | See the License for the specific language governing rights and limitations 26 | under the License. 27 | 28 | Alternatively, the contents of this file may be used under the terms of 29 | the GNU General Public License Version 2 or later (the "GPL") 30 | See http://www.gnu.org/licenses/gpl.html 31 | ------------------------------------------------------------------------------*) 32 | {*)} 33 | 34 | {$I JcfGlobal.inc} 35 | 36 | interface 37 | 38 | uses Warning; 39 | 40 | type 41 | 42 | TWarnDestroy = class(TWarning) 43 | public 44 | function EnabledVisitSourceToken(const pcToken: TObject): Boolean; override; 45 | end; 46 | 47 | implementation 48 | 49 | uses 50 | { delphi } 51 | {$IFNDEF FPC}Windows,{$ENDIF} SysUtils, 52 | { local } 53 | SourceToken, ParseTreeNodeType, ParseTreeNode; 54 | 55 | function TWarnDestroy.EnabledVisitSourceToken(const pcToken: TObject): Boolean; 56 | var 57 | lcToken: TSourceToken; 58 | lcFunction: TParseTreeNode; 59 | begin 60 | Result := False; 61 | lcToken := TSourceToken(pcToken); 62 | 63 | { look in statements } 64 | if not lcToken.HasParentNode(nBlock) then 65 | exit; 66 | 67 | if not AnsiSameText(lcToken.SourceCode, 'destroy') then 68 | exit; 69 | 70 | { is OK in destructors as 'inherited destroy' } 71 | lcFunction := lcToken.GetParentNode(ProcedureNodes + [nInitSection]); 72 | 73 | if (lcFunction <> nil) and (lcFunction.NodeType = nDestructorDecl) then 74 | exit; 75 | 76 | SendWarning(lcToken, 'Destroy should not normally be called. ' + 77 | 'You may want to use FreeAndNil(MyObj), or MyObj.Free, or MyForm.Release'); 78 | end; 79 | 80 | end. 81 | -------------------------------------------------------------------------------- /Process/Warnings/WarnEmptyBlock.pas: -------------------------------------------------------------------------------- 1 | unit WarnEmptyBlock; 2 | 3 | { AFS 30 Dec 2002 4 | warn of an enmpty block, one of 5 | begin..end, try..except, try..finally, except..end, finally..end 6 | } 7 | 8 | 9 | {(*} 10 | (*------------------------------------------------------------------------------ 11 | Delphi Code formatter source code 12 | 13 | The Original Code is WarnEmptyBlock, released May 2003. 14 | The Initial Developer of the Original Code is Anthony Steele. 15 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 16 | All Rights Reserved. 17 | Contributor(s): Anthony Steele. 18 | 19 | The contents of this file are subject to the Mozilla Public License Version 1.1 20 | (the "License"). you may not use this file except in compliance with the License. 21 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 22 | 23 | Software distributed under the License is distributed on an "AS IS" basis, 24 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 25 | See the License for the specific language governing rights and limitations 26 | under the License. 27 | 28 | Alternatively, the contents of this file may be used under the terms of 29 | the GNU General Public License Version 2 or later (the "GPL") 30 | See http://www.gnu.org/licenses/gpl.html 31 | ------------------------------------------------------------------------------*) 32 | {*)} 33 | 34 | {$I JcfGlobal.inc} 35 | 36 | interface 37 | 38 | uses Warning; 39 | 40 | type 41 | 42 | TWarnEmptyBlock = class(TWarning) 43 | public 44 | constructor Create; override; 45 | 46 | procedure PreVisitParseTreeNode(const pcNode: TObject); override; 47 | end; 48 | 49 | implementation 50 | 51 | uses ParseTreeNode, ParseTreeNodeType; 52 | 53 | constructor TWarnEmptyBlock.Create; 54 | begin 55 | inherited; 56 | 57 | HasPreVisit := True; 58 | HasPostVisit := False; 59 | HasSourceTokenVisit := False; 60 | end; 61 | 62 | procedure TWarnEmptyBlock.PreVisitParseTreeNode(const pcNode: TObject); 63 | var 64 | lcNode: TParseTreeNode; 65 | liSolidChildCount: integer; 66 | begin 67 | lcNode := TParseTreeNode(pcNode); 68 | 69 | // only look in statements 70 | if not lcNode.HasParentNode(nBlock) then 71 | exit; 72 | 73 | { looking for nodes with 2 solid tokens under them 74 | e.g. 'begin' and 'end' 75 | } 76 | liSolidChildCount := lcNode.SolidChildCount; 77 | 78 | if liSolidChildCount = 2 then 79 | begin 80 | if lcNode.NodeType = nCompoundStatement then 81 | begin 82 | SendWarning(lcNode, 'Empty begin..end block'); 83 | end; 84 | 85 | if lcNode.NodeType = nFinallyBlock then 86 | begin 87 | SendWarning(lcNode, 'Empty finally..end block'); 88 | end; 89 | 90 | if lcNode.NodeType = nExceptBlock then 91 | begin 92 | SendWarning(lcNode, 'Empty except..end block'); 93 | end; 94 | end 95 | else if liSolidChildCount = 1 then 96 | begin 97 | if lcNode.NodeType = nTryBlock then 98 | begin 99 | SendWarning(lcNode, 'Empty try block'); 100 | end; 101 | end; 102 | 103 | end; 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /Process/Warnings/WarnRealType.pas: -------------------------------------------------------------------------------- 1 | unit WarnRealType; 2 | 3 | { AFS 30 Dec 2002 4 | 5 | simple warner - these types are obsolete 6 | } 7 | 8 | {(*} 9 | (*------------------------------------------------------------------------------ 10 | Delphi Code formatter source code 11 | 12 | The Original Code is WarnRealType, released May 2003. 13 | The Initial Developer of the Original Code is Anthony Steele. 14 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 15 | All Rights Reserved. 16 | Contributor(s): Anthony Steele. 17 | 18 | The contents of this file are subject to the Mozilla Public License Version 1.1 19 | (the "License"). you may not use this file except in compliance with the License. 20 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 21 | 22 | Software distributed under the License is distributed on an "AS IS" basis, 23 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 24 | See the License for the specific language governing rights and limitations 25 | under the License. 26 | 27 | Alternatively, the contents of this file may be used under the terms of 28 | the GNU General Public License Version 2 or later (the "GPL") 29 | See http://www.gnu.org/licenses/gpl.html 30 | ------------------------------------------------------------------------------*) 31 | {*)} 32 | 33 | {$I JcfGlobal.inc} 34 | 35 | interface 36 | 37 | 38 | uses Warning; 39 | 40 | type 41 | 42 | TWarnRealType = class(TWarning) 43 | public 44 | function EnabledVisitSourceToken(const pcToken: TObject): Boolean; override; 45 | end; 46 | 47 | implementation 48 | 49 | uses SourceToken, ParseTreeNodeType, Tokens; 50 | 51 | function TWarnRealType.EnabledVisitSourceToken(const pcToken: TObject): Boolean; 52 | const 53 | REAL_WARNING = ' This type is obsolete and is seldom useful'; 54 | // + 'See the help for details'; 55 | var 56 | lcToken: TSourceToken; 57 | begin 58 | Result := False; 59 | lcToken := TSourceToken(pcToken); 60 | 61 | if not lcToken.HasParentNode(nType) then 62 | exit; 63 | 64 | { see delphi help on 'real' for details. 65 | I don't know any reason to prefer these types to 'Double' 66 | 67 | If the code was orignally Delphi V1, then it may be better of as "Currency" 68 | } 69 | 70 | if lcToken.TokenType = ttReal then 71 | begin 72 | SendWarning(lcToken, 'Real type used.' + REAL_WARNING); 73 | end 74 | else if lcToken.TokenType = ttReal48 then 75 | begin 76 | SendWarning(lcToken, 'Real48 type used.' + REAL_WARNING); 77 | end; 78 | 79 | end; 80 | 81 | end. 82 | -------------------------------------------------------------------------------- /Process/Warnings/Warning.pas: -------------------------------------------------------------------------------- 1 | unit Warning; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is Warning, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses SwitchableVisitor, ConvertTypes; 33 | 34 | type 35 | TWarning = class(TSwitchableVisitor) 36 | private 37 | fOnWarning: TStatusMessageProc; 38 | 39 | protected 40 | procedure SendWarning(const pcNode: TObject; const psMessage: string); 41 | 42 | public 43 | constructor Create; override; 44 | 45 | function IsIncludedInSettings: boolean; override; 46 | 47 | property OnWarning: TStatusMessageProc Read fOnWarning Write fOnWarning; 48 | end; 49 | 50 | 51 | implementation 52 | 53 | uses ParseTreeNode, SourceToken, TokenUtils, FormatFlags, JcfSettings; 54 | 55 | constructor TWarning.Create; 56 | begin 57 | inherited; 58 | FormatFlags := FormatFlags + [eWarning]; 59 | end; 60 | 61 | function TWarning.IsIncludedInSettings: boolean; 62 | begin 63 | // included if warnings are turned on 64 | Result := FormatSettings.Clarify.Warnings; 65 | end; 66 | 67 | procedure TWarning.SendWarning(const pcNode: TObject; const psMessage: string); 68 | var 69 | lsMessage, lsProc: string; 70 | lcToken: TSourceToken; 71 | begin 72 | { don't bother with the rest } 73 | if not Assigned(fOnWarning) then 74 | exit; 75 | 76 | lsMessage := psMessage; 77 | if (pcNode is TSourceToken) then 78 | begin 79 | lcToken := TSourceToken(pcNode); 80 | end 81 | else if (pcNode is TParseTreeNode) then 82 | begin 83 | // use first token under this node for pos 84 | lcToken := TParseTreeNode(pcNode).FirstSolidLeaf as TSourceToken; 85 | end 86 | else 87 | lcToken := nil; 88 | 89 | if lcToken <> nil then 90 | begin 91 | lsMessage := lsMessage + ' near ' + lcToken.Describe; 92 | lsProc := GetProcedureName(lcToken, True, False); 93 | if lsProc <> '' then 94 | lsMessage := lsMessage + ' in ' + GetBlockType(lcToken) + ' ' + lsProc; 95 | end; 96 | 97 | fOnWarning('', lsMessage, mtCodeWarning, lcToken.YPosition, lcToken.XPosition); 98 | end; 99 | 100 | 101 | 102 | end. 103 | -------------------------------------------------------------------------------- /ReadWrite/EditorWriter.pas: -------------------------------------------------------------------------------- 1 | unit EditorWriter; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is EditorWriter.pas, released January 2001. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 2001 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { writer class for use in IDE pluggin - writes to the editor interface } 33 | 34 | uses 35 | { delphi design time }ToolsAPI, 36 | { local }CodeWriter; 37 | 38 | type 39 | 40 | TEditorWriter = class(TCodeWriter) 41 | private 42 | fciUnit: IOTASourceEditor; 43 | protected 44 | public 45 | 46 | procedure Close; override; 47 | 48 | constructor Create; override; 49 | procedure SetEditorUnit(const pciUnit: IOTASourceEditor); 50 | 51 | end; 52 | 53 | implementation 54 | 55 | constructor TEditorWriter.Create; 56 | begin 57 | inherited; 58 | fciUnit := nil; 59 | end; 60 | 61 | procedure TEditorWriter.SetEditorUnit(const pciUnit: IOTASourceEditor); 62 | begin 63 | fciUnit := pciUnit; 64 | end; 65 | 66 | procedure TEditorWriter.Close; 67 | var 68 | lciEditorWriter: IOTAEditWriter; 69 | // liEndPos: integer; 70 | begin 71 | if fciUnit = nil then 72 | exit; 73 | 74 | lciEditorWriter := fciUnit.CreateUndoableWriter; 75 | Assert(lciEditorWriter <> nil); 76 | 77 | if lciEditorWriter = nil then 78 | exit; 79 | 80 | BeforeWrite; 81 | 82 | //debug ShowMessage(fsDestText); 83 | 84 | { these next 2 steps should rather be done in one operation 85 | so as to be unitary in the undo history 86 | but I don't know how to do that, or if it is possible } 87 | 88 | { delete what's there } 89 | lciEditorWriter.DeleteTo(High(integer)); 90 | { put the changed text in instead } 91 | lciEditorWriter.Insert(pchar(fsDestText)); 92 | 93 | { delete after the 'end.' } 94 | //liEndPos := PosOfLastSolidText(fsDestText); 95 | //lciEditorWriter.CurrentPos 96 | 97 | // ditch the interfaces 98 | lciEditorWriter := nil; 99 | fciUnit := nil; 100 | 101 | fsDestText := ''; 102 | end; 103 | 104 | end. 105 | -------------------------------------------------------------------------------- /ReadWrite/FileReader.pas: -------------------------------------------------------------------------------- 1 | unit FileReader; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is FileReader.pas, released April 2000. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2000 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | { Created AFS 27 November 1999 29 | reader for Code formatting util 30 | 31 | The method is to first read the entire file into a string 32 | This is a textbook optimization - 1 read for the whole file 33 | instead of 1 per char. The file may be large 34 | (the largest file that ships with Delphi5, excel2000.pas, is 4Mb!!!!) 35 | but even this should fit into memory 36 | This technique is not optimised for files of that size, 37 | but hey, that is not the normal case, 38 | and code like that has got to be machine-generated anyway. 39 | Why would it need machine-reformatting? 40 | 41 | 8 Jan 2K - the original code is now split into 42 | TReader (base class) and TFileReader (read from file 43 | so that another subclass (TIDEReader) can be made for the IDE pluggin 44 | with the same interface 45 | } 46 | 47 | {$I JcfGlobal.inc} 48 | 49 | interface 50 | 51 | uses CodeReader; 52 | 53 | type 54 | TFileReader = class(TCodeReader) 55 | private 56 | { working vars } 57 | { property implementation } 58 | FsSourceFileName: string; 59 | 60 | procedure SetSourceFileName(const psValue: string); 61 | 62 | protected 63 | procedure ReadFromSource; override; 64 | public 65 | procedure Clear; override; 66 | 67 | property SourceFileName: string Read FsSourceFileName Write SetSourceFileName; 68 | end; 69 | 70 | implementation 71 | 72 | uses 73 | {delphi }SysUtils, 74 | JclAnsiStrings; 75 | 76 | { TFileReader } 77 | 78 | procedure TFileReader.Clear; 79 | begin 80 | inherited; 81 | FsSourceFileName := ''; 82 | end; 83 | 84 | procedure TFileReader.SetSourceFileName(const psValue: string); 85 | begin 86 | FsSourceFileName := psValue; 87 | end; 88 | 89 | procedure TFileReader.ReadFromSource; 90 | begin 91 | if fbHasRead then 92 | exit; 93 | 94 | // Open the file 95 | Assert(FileExists(SourceFileName), 'No file ' + SourceFileName); 96 | 97 | fsSource := FileToString(SourceFileName); 98 | 99 | fiSourceLength := Length(fsSource); 100 | 101 | fiReadIndex := 1; 102 | fiBufferLength := 1; 103 | fbHasRead := True; 104 | end; 105 | 106 | 107 | end. 108 | -------------------------------------------------------------------------------- /ReadWrite/FileWriter.pas: -------------------------------------------------------------------------------- 1 | {(*} 2 | (*------------------------------------------------------------------------------ 3 | Delphi Code formatter source code 4 | 5 | The Original Code is Writer.pas, released April 2000. 6 | The Initial Developer of the Original Code is Anthony Steele. 7 | Portions created by Anthony Steele are Copyright (C) 1999-2000 Anthony Steele. 8 | All Rights Reserved. 9 | Contributor(s): Anthony Steele. 10 | 11 | The contents of this file are subject to the Mozilla Public License Version 1.1 12 | (the "License"). you may not use this file except in compliance with the License. 13 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 14 | 15 | Software distributed under the License is distributed on an "AS IS" basis, 16 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 17 | See the License for the specific language governing rights and limitations 18 | under the License. 19 | 20 | Alternatively, the contents of this file may be used under the terms of 21 | the GNU General Public License Version 2 or later (the "GPL") 22 | See http://www.gnu.org/licenses/gpl.html 23 | ------------------------------------------------------------------------------*) 24 | {*)} 25 | 26 | unit FileWriter; 27 | 28 | { AFS 28 November 1999 29 | Writer - final output stage of code formattter 30 | 31 | AFS 22 July 2K - optimised by using a string to store tokens, 32 | and writing the file at once 33 | } 34 | 35 | {$I JcfGlobal.inc} 36 | 37 | interface 38 | 39 | uses CodeWriter; 40 | 41 | type 42 | TFileWriter = class(TCodeWriter) 43 | private 44 | { properties } 45 | FOutputFileName: string; 46 | procedure SetOutputFileName(const Value: string); 47 | 48 | protected 49 | 50 | public 51 | constructor Create; override; 52 | 53 | procedure Close; override; 54 | 55 | property OutputFileName: string Read FOutputFileName Write SetOutputFileName; 56 | end; 57 | 58 | implementation 59 | 60 | uses 61 | { delphi }SysUtils; 62 | 63 | constructor TFileWriter.Create; 64 | begin 65 | inherited; 66 | FOutputFileName := ''; 67 | end; 68 | 69 | 70 | procedure TFileWriter.SetOutputFileName(const Value: string); 71 | begin 72 | FOutputFileName := Value; 73 | end; 74 | 75 | procedure TFileWriter.Close; 76 | var 77 | lfOutput: file; 78 | pChars: Pointer; 79 | begin 80 | if BOF then 81 | exit; 82 | 83 | Assert(OutputFileName <> ''); 84 | Assert( not FileExists(OutputFileName)); 85 | 86 | BeforeWrite; 87 | pChars := pchar(fsDestText); 88 | 89 | { write the file } 90 | AssignFile(lfOutput, OutputFileName); 91 | Rewrite(lfOutput, 1); 92 | {$WARNINGS OFF} 93 | BlockWrite(lfOutput, pChars^, Length(fsDestText)); 94 | {$WARNINGS ON} 95 | CloseFile(lfOutput); 96 | 97 | { reset state } 98 | FOutputFileName := ''; 99 | fsDestText := ''; 100 | fbBOF := True; 101 | end; 102 | 103 | end. 104 | -------------------------------------------------------------------------------- /ReadWrite/StringsConverter.pas: -------------------------------------------------------------------------------- 1 | unit StringsConverter; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is StringsConverter, released May 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2000 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses 33 | { delphi } 34 | Classes, 35 | { local } 36 | Converter; 37 | 38 | type 39 | TStringsConverter = class(TObject) 40 | private 41 | fcMessageStrings: TStrings; 42 | 43 | procedure SetMessageStrings(const pcStrings: TStrings); 44 | function GetMessageStrings: TStrings; 45 | 46 | protected 47 | function OriginalFileName: string; 48 | 49 | procedure SendStatusMessage(const psFile, psMessage: string; 50 | const piY, piX: integer); 51 | 52 | public 53 | constructor Create; 54 | 55 | procedure Convert; 56 | 57 | property MessageStrings: TStrings Read GetMessageStrings Write SetMessageStrings; 58 | end; 59 | 60 | 61 | implementation 62 | 63 | uses SysUtils; 64 | 65 | constructor TStringsConverter.Create; 66 | begin 67 | inherited; 68 | fcMessageStrings := nil; 69 | end; 70 | 71 | 72 | procedure TStringsConverter.Convert; 73 | begin 74 | // show message on popup if there is no message output 75 | //GuiMessages := (fcMessageStrings = nil); 76 | 77 | //DoConvertUnit; 78 | end; 79 | 80 | function TStringsConverter.GetMessageStrings: TStrings; 81 | begin 82 | Result := fcMessageStrings; 83 | end; 84 | 85 | 86 | function TStringsConverter.OriginalFileName: string; 87 | begin 88 | Result := 'text'; 89 | end; 90 | 91 | procedure TStringsConverter.SetMessageStrings(const pcStrings: TStrings); 92 | begin 93 | fcMessageStrings := pcStrings; 94 | end; 95 | 96 | procedure TStringsConverter.SendStatusMessage(const psFile, psMessage: string; 97 | const piY, piX: integer); 98 | var 99 | lsWholeMessage: string; 100 | begin 101 | if fcMessageStrings <> nil then 102 | begin 103 | lsWholeMessage := psMessage; 104 | if (piY >= 0) and (piX >= 0) then 105 | lsWholeMessage := lsWholeMessage + ' at line ' + IntToStr(piY) + 106 | ' col ' + IntToStr(piX); 107 | 108 | 109 | fcMessageStrings.Add(lsWholeMessage); 110 | end; 111 | 112 | end; 113 | 114 | end. 115 | -------------------------------------------------------------------------------- /ReadWrite/StringsReader.pas: -------------------------------------------------------------------------------- 1 | unit StringsReader; 2 | 3 | { 4 | AFS 1 Jan 2003 5 | Attach the formatter to TStrings 6 | } 7 | 8 | {(*} 9 | (*------------------------------------------------------------------------------ 10 | Delphi Code formatter source code 11 | 12 | The Original Code is StringsReader, released May 2003. 13 | The Initial Developer of the Original Code is Anthony Steele. 14 | Portions created by Anthony Steele are Copyright (C) 1999-2000 Anthony Steele. 15 | All Rights Reserved. 16 | Contributor(s): Anthony Steele. 17 | 18 | The contents of this file are subject to the Mozilla Public License Version 1.1 19 | (the "License"). you may not use this file except in compliance with the License. 20 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 21 | 22 | Software distributed under the License is distributed on an "AS IS" basis, 23 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 24 | See the License for the specific language governing rights and limitations 25 | under the License. 26 | 27 | Alternatively, the contents of this file may be used under the terms of 28 | the GNU General Public License Version 2 or later (the "GPL") 29 | See http://www.gnu.org/licenses/gpl.html 30 | ------------------------------------------------------------------------------*) 31 | {*)} 32 | 33 | {$I JcfGlobal.inc} 34 | 35 | interface 36 | 37 | uses 38 | { delphi }Classes, 39 | { local }CodeReader; 40 | 41 | type 42 | TStringsReader = class(TCodeReader) 43 | private 44 | { property implementation } 45 | FcInputStrings: TStrings; 46 | 47 | 48 | protected 49 | procedure ReadFromSource; override; 50 | public 51 | procedure Clear; override; 52 | 53 | property InputStrings: TStrings Read FcInputStrings Write FcInputStrings; 54 | end; 55 | 56 | 57 | implementation 58 | 59 | { TSTringsReader } 60 | 61 | procedure TStringsReader.Clear; 62 | begin 63 | inherited; 64 | FcInputStrings := nil; 65 | end; 66 | 67 | procedure TStringsReader.ReadFromSource; 68 | begin 69 | if fbHasRead then 70 | exit; 71 | 72 | // Open the file 73 | Assert((FcInputStrings <> nil), 'No source strings'); 74 | 75 | fsSource := FcInputStrings.Text; 76 | 77 | fiSourceLength := Length(fsSource); 78 | 79 | fiReadIndex := 1; 80 | fiBufferLength := 1; 81 | fbHasRead := True; 82 | end; 83 | 84 | end. 85 | -------------------------------------------------------------------------------- /ReadWrite/StringsWriter.pas: -------------------------------------------------------------------------------- 1 | unit StringsWriter; 2 | 3 | { 4 | Write converter output to strings 5 | } 6 | 7 | {(*} 8 | (*------------------------------------------------------------------------------ 9 | Delphi Code formatter source code 10 | 11 | The Original Code is StringsWriter, released May 2003. 12 | The Initial Developer of the Original Code is Anthony Steele. 13 | Portions created by Anthony Steele are Copyright (C) 1999-2000 Anthony Steele. 14 | All Rights Reserved. 15 | Contributor(s): Anthony Steele. 16 | 17 | The contents of this file are subject to the Mozilla Public License Version 1.1 18 | (the "License"). you may not use this file except in compliance with the License. 19 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 20 | 21 | Software distributed under the License is distributed on an "AS IS" basis, 22 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 23 | See the License for the specific language governing rights and limitations 24 | under the License. 25 | 26 | Alternatively, the contents of this file may be used under the terms of 27 | the GNU General Public License Version 2 or later (the "GPL") 28 | See http://www.gnu.org/licenses/gpl.html 29 | ------------------------------------------------------------------------------*) 30 | {*)} 31 | 32 | {$I JcfGlobal.inc} 33 | 34 | interface 35 | 36 | uses 37 | { delphi }Classes, 38 | { local }CodeWriter; 39 | 40 | type 41 | TStringsWriter = class(TCodeWriter) 42 | private 43 | { properties } 44 | fcOutputStrings: TStrings; 45 | 46 | protected 47 | 48 | public 49 | constructor Create; override; 50 | procedure Close; override; 51 | 52 | property OutputStrings: TStrings Read fcOutputStrings Write fcOutputStrings; 53 | end; 54 | 55 | implementation 56 | 57 | { TStringsWriter } 58 | constructor TStringsWriter.Create; 59 | begin 60 | inherited; 61 | fcOutputStrings := nil; 62 | end; 63 | 64 | procedure TStringsWriter.Close; 65 | begin 66 | if BOF then 67 | exit; 68 | 69 | Assert(fcOutputStrings <> nil); 70 | 71 | BeforeWrite; 72 | fcOutputStrings.Text := fsDestText; 73 | end; 74 | 75 | 76 | end. 77 | -------------------------------------------------------------------------------- /Settings/JcfSetBase.pas: -------------------------------------------------------------------------------- 1 | {(*} 2 | (*------------------------------------------------------------------------------ 3 | Delphi Code formatter source code 4 | 5 | The Original Code is SetBase.pas, released April 2000. 6 | The Initial Developer of the Original Code is Anthony Steele. 7 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 8 | All Rights Reserved. 9 | Contributor(s): Anthony Steele. 10 | 11 | The contents of this file are subject to the Mozilla Public License Version 1.1 12 | (the "License"). you may not use this file except in compliance with the License. 13 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 14 | 15 | Software distributed under the License is distributed on an "AS IS" basis, 16 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 17 | See the License for the specific language governing rights and limitations 18 | under the License. 19 | 20 | Alternatively, the contents of this file may be used under the terms of 21 | the GNU General Public License Version 2 or later (the "GPL") 22 | See http://www.gnu.org/licenses/gpl.html 23 | ------------------------------------------------------------------------------*) 24 | {*)} 25 | 26 | unit JcfSetBase; 27 | 28 | { base class for a group of settings 29 | AFS 29 Dec 1999 30 | 31 | } 32 | 33 | {$I JcfGlobal.inc} 34 | 35 | interface 36 | 37 | uses 38 | { local } 39 | SettingsStream; 40 | 41 | type 42 | 43 | TSetBase = class(TObject) 44 | private 45 | fsSection: string; 46 | 47 | protected 48 | procedure SetSection(const ps: string); 49 | 50 | public 51 | procedure WriteToStream(const pcStream: TSettingsOutput); virtual; abstract; 52 | procedure ReadFromStream(const pcStream: TSettingsInput); virtual; abstract; 53 | 54 | property Section: string Read fsSection; 55 | end; 56 | 57 | implementation 58 | 59 | procedure TSetBase.SetSection(const ps: string); 60 | begin 61 | fsSection := ps; 62 | end; 63 | 64 | end. 65 | -------------------------------------------------------------------------------- /Settings/SetComments.pas: -------------------------------------------------------------------------------- 1 | unit SetComments; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is SetComments.pas, released November 2000. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | { options on working with comments 29 | For now only options to remove empty comments 30 | but there may be more } 31 | 32 | {$I JcfGlobal.inc} 33 | 34 | interface 35 | 36 | uses JcfSetBase, SettingsStream; 37 | 38 | type 39 | 40 | TSetComments = class(TSetBase) 41 | private 42 | fbRemoveEmptyDoubleSlashComments: boolean; 43 | fbRemoveEmptyCurlyBraceComments: boolean; 44 | 45 | protected 46 | public 47 | constructor Create; 48 | 49 | procedure WriteToStream(const pcOut: TSettingsOutput); override; 50 | procedure ReadFromStream(const pcStream: TSettingsInput); override; 51 | 52 | property RemoveEmptyDoubleSlashComments: boolean 53 | Read fbRemoveEmptyDoubleSlashComments Write fbRemoveEmptyDoubleSlashComments; 54 | property RemoveEmptyCurlyBraceComments: boolean 55 | Read fbRemoveEmptyCurlyBraceComments Write fbRemoveEmptyCurlyBraceComments; 56 | end; 57 | 58 | implementation 59 | 60 | const 61 | REG_REMOVE_EMPTY_DOUBLE_SLASH_COMMENTS = 'RemoveEmptyDoubleSlashComments'; 62 | REG_REMOVE_EMPTY_CURLY_BRACE_COMMENTS = 'RemoveEmptyCurlyBraceComments'; 63 | 64 | constructor TSetComments.Create; 65 | begin 66 | inherited; 67 | SetSection('Comments'); 68 | end; 69 | 70 | procedure TSetComments.ReadFromStream(const pcStream: TSettingsInput); 71 | begin 72 | Assert(pcStream <> nil); 73 | 74 | fbRemoveEmptyDoubleSlashComments := 75 | pcStream.Read(REG_REMOVE_EMPTY_DOUBLE_SLASH_COMMENTS, True); 76 | fbRemoveEmptyCurlyBraceComments := 77 | pcStream.Read(REG_REMOVE_EMPTY_CURLY_BRACE_COMMENTS, True); 78 | end; 79 | 80 | procedure TSetComments.WriteToStream(const pcOut: TSettingsOutput); 81 | begin 82 | Assert(pcOut <> nil); 83 | 84 | pcOut.Write(REG_REMOVE_EMPTY_DOUBLE_SLASH_COMMENTS, fbRemoveEmptyDoubleSlashComments); 85 | pcOut.Write(REG_REMOVE_EMPTY_CURLY_BRACE_COMMENTS, fbRemoveEmptyCurlyBraceComments); 86 | end; 87 | 88 | end. 89 | -------------------------------------------------------------------------------- /Settings/SetFile.pas: -------------------------------------------------------------------------------- 1 | {(*} 2 | (*------------------------------------------------------------------------------ 3 | Delphi Code formatter source code 4 | 5 | The Original Code is SetFile.pas, released April 2000. 6 | The Initial Developer of the Original Code is Anthony Steele. 7 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 8 | All Rights Reserved. 9 | Contributor(s): Anthony Steele. 10 | 11 | The contents of this file are subject to the Mozilla Public License Version 1.1 12 | (the "License"). you may not use this file except in compliance with the License. 13 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 14 | 15 | Software distributed under the License is distributed on an "AS IS" basis, 16 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 17 | See the License for the specific language governing rights and limitations 18 | under the License. 19 | 20 | Alternatively, the contents of this file may be used under the terms of 21 | the GNU General Public License Version 2 or later (the "GPL") 22 | See http://www.gnu.org/licenses/gpl.html 23 | ------------------------------------------------------------------------------*) 24 | {*)} 25 | 26 | unit SetFile; 27 | 28 | { settings to do with files 29 | AFS 29 Dec 1999 30 | } 31 | 32 | {$I JcfGlobal.inc} 33 | 34 | interface 35 | 36 | uses 37 | { local } 38 | JcfSetBase, SettingsStream; 39 | 40 | type 41 | 42 | TSetFile = class(TSetBase) 43 | private 44 | protected 45 | 46 | public 47 | constructor Create; 48 | destructor Destroy; override; 49 | 50 | procedure WriteToStream(const pcOut: TSettingsOutput); override; 51 | procedure ReadFromStream(const pcStream: TSettingsInput); override; 52 | end; 53 | 54 | implementation 55 | 56 | constructor TSetFile.Create; 57 | begin 58 | inherited; 59 | 60 | 61 | SetSection('File'); 62 | end; 63 | 64 | destructor TSetFile.Destroy; 65 | begin 66 | inherited; 67 | end; 68 | 69 | procedure TSetFile.ReadFromStream(const pcStream: TSettingsInput); 70 | begin 71 | Assert(pcStream <> nil); 72 | 73 | end; 74 | 75 | procedure TSetFile.WriteToStream(const pcOut: TSettingsOutput); 76 | begin 77 | Assert(pcOut <> nil); 78 | 79 | end; 80 | 81 | end. 82 | -------------------------------------------------------------------------------- /Settings/SettingsTypes.pas: -------------------------------------------------------------------------------- 1 | unit SettingsTypes; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is SettingsTypes.pas, released June 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | // types and constants used in settings 33 | 34 | { can stop and restart formating using these comments 35 | from DelForExp - Egbbert Van Nes's program } 36 | const 37 | NOFORMAT_ON = '{(*}'; 38 | NOFORMAT_OFF = '{*)}'; 39 | 40 | NOFORMAT_ON_2 = '//jcf:format=off'; 41 | NOFORMAT_OFF_2 = '//jcf:format=on'; 42 | 43 | 44 | type 45 | TCapitalisationType = (ctUpper, ctLower, ctMixed, ctLeaveAlone); 46 | 47 | { used in several places for a user setting, e.g. 48 | return after Then and other strategic places? 49 | } 50 | TTriOptionStyle = (eAlways, eLeave, eNever); 51 | 52 | { what to do with return characters (Cr or CrLf) 53 | 1) leave them as is 54 | 2) turn to Lf 55 | 3) turn to CrLf 56 | 4) pick 2 or 3 depending on the Host OS, preference, ie CrLf for win, Cr for 'nix 57 | } 58 | type 59 | TReturnChars = (rcLeaveAsIs, rcLinefeed, rcCrLf, rcPlatform); 60 | 61 | 62 | implementation 63 | 64 | end. 65 | -------------------------------------------------------------------------------- /Ui/Settings/frAnyCapsSettings.lfm: -------------------------------------------------------------------------------- 1 | inherited frAnyCapsSettings: TfrAnyCapsSettings 2 | Height = 230 3 | Width = 366 4 | ClientHeight = 230 5 | ClientWidth = 366 6 | OnResize = FrameResize 7 | TabOrder = 0 8 | DesignLeft = 649 9 | DesignTop = 352 10 | object Label1: TLabel[0] 11 | AnchorSideLeft.Control = Owner 12 | AnchorSideLeft.Side = asrCenter 13 | AnchorSideTop.Control = Owner 14 | Left = 102 15 | Height = 14 16 | Top = 0 17 | Width = 162 18 | Caption = 'Set capitalisation on these words ' 19 | ParentColor = False 20 | end 21 | object cbEnableAnyWords: TCheckBox[1] 22 | AnchorSideLeft.Control = Owner 23 | AnchorSideTop.Control = Owner 24 | Left = 6 25 | Height = 17 26 | Top = 6 27 | Width = 50 28 | BorderSpacing.Around = 6 29 | Caption = 'Enable' 30 | Checked = True 31 | OnClick = cbEnableAnyWordsClick 32 | State = cbChecked 33 | TabOrder = 0 34 | end 35 | object mWords: TMemo[2] 36 | AnchorSideLeft.Control = Owner 37 | AnchorSideTop.Control = cbEnableAnyWords 38 | AnchorSideTop.Side = asrBottom 39 | AnchorSideRight.Control = Owner 40 | AnchorSideBottom.Control = Owner 41 | Left = 6 42 | Height = 195 43 | Top = 29 44 | Width = 354 45 | Align = alBottom 46 | Anchors = [akTop, akLeft, akRight, akBottom] 47 | BorderSpacing.Around = 6 48 | ScrollBars = ssVertical 49 | TabOrder = 1 50 | end 51 | end 52 | -------------------------------------------------------------------------------- /Ui/Settings/frClarify.lfm: -------------------------------------------------------------------------------- 1 | inherited fClarify: TfClarify 2 | Height = 292 3 | Width = 426 4 | ClientHeight = 292 5 | ClientWidth = 426 6 | TabOrder = 0 7 | DesignLeft = 130 8 | DesignTop = 131 9 | object Label1: TLabel[0] 10 | AnchorSideLeft.Control = Owner 11 | AnchorSideTop.Control = Owner 12 | Left = 6 13 | Height = 14 14 | Top = 6 15 | Width = 124 16 | BorderSpacing.Around = 6 17 | Caption = 'File extensions to format:' 18 | ParentColor = False 19 | end 20 | object rgRunOnceOffs: TRadioGroup[1] 21 | AnchorSideLeft.Control = mFileExtensions 22 | AnchorSideLeft.Side = asrBottom 23 | AnchorSideTop.Control = mFileExtensions 24 | AnchorSideRight.Control = Owner 25 | AnchorSideRight.Side = asrBottom 26 | Left = 166 27 | Height = 81 28 | Top = 26 29 | Width = 254 30 | Anchors = [akTop, akLeft, akRight] 31 | AutoFill = True 32 | AutoSize = True 33 | BorderSpacing.Left = 6 34 | BorderSpacing.Right = 6 35 | Caption = 'Run once-offs' 36 | ChildSizing.LeftRightSpacing = 6 37 | ChildSizing.TopBottomSpacing = 6 38 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 39 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 40 | ChildSizing.ShrinkHorizontal = crsScaleChilds 41 | ChildSizing.ShrinkVertical = crsScaleChilds 42 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 43 | ChildSizing.ControlsPerLine = 1 44 | ClientHeight = 63 45 | ClientWidth = 250 46 | Items.Strings = ( 47 | 'Do ¬ run' 48 | 'Do &run' 49 | 'Run &only these' 50 | ) 51 | TabOrder = 0 52 | end 53 | object mFileExtensions: TMemo[2] 54 | AnchorSideLeft.Control = Label1 55 | AnchorSideTop.Control = Label1 56 | AnchorSideTop.Side = asrBottom 57 | Left = 6 58 | Height = 127 59 | Top = 26 60 | Width = 154 61 | BorderSpacing.Top = 6 62 | TabOrder = 1 63 | end 64 | end 65 | -------------------------------------------------------------------------------- /Ui/Settings/frClarifyLongLineBreaker.lfm: -------------------------------------------------------------------------------- 1 | inherited fClarifyLongLineBreaker: TfClarifyLongLineBreaker 2 | Height = 194 3 | Width = 437 4 | ClientHeight = 194 5 | ClientWidth = 437 6 | TabOrder = 0 7 | object Label3: TLabel[0] 8 | AnchorSideLeft.Control = Owner 9 | AnchorSideTop.Control = edtMaxLineLength 10 | AnchorSideTop.Side = asrCenter 11 | Left = 6 12 | Height = 14 13 | Top = 9 14 | Width = 73 15 | BorderSpacing.Left = 6 16 | Caption = 'Max line length' 17 | ParentColor = False 18 | end 19 | object edtMaxLineLength: TSpinEdit[1] 20 | AnchorSideLeft.Control = Label3 21 | AnchorSideLeft.Side = asrBottom 22 | AnchorSideTop.Control = Owner 23 | Left = 85 24 | Height = 21 25 | Top = 6 26 | Width = 49 27 | BorderSpacing.Around = 6 28 | MaxValue = 999 29 | TabOrder = 0 30 | end 31 | object rgRebreakLongLines: TRadioGroup[2] 32 | AnchorSideLeft.Control = Owner 33 | AnchorSideTop.Control = edtMaxLineLength 34 | AnchorSideTop.Side = asrBottom 35 | AnchorSideRight.Control = Owner 36 | AnchorSideRight.Side = asrBottom 37 | Left = 6 38 | Height = 81 39 | Top = 33 40 | Width = 425 41 | Anchors = [akTop, akLeft, akRight] 42 | AutoFill = True 43 | AutoSize = True 44 | BorderSpacing.Around = 6 45 | Caption = '&Break lines that are longer than max line length' 46 | ChildSizing.LeftRightSpacing = 6 47 | ChildSizing.TopBottomSpacing = 6 48 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 49 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 50 | ChildSizing.ShrinkHorizontal = crsScaleChilds 51 | ChildSizing.ShrinkVertical = crsScaleChilds 52 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 53 | ChildSizing.ControlsPerLine = 1 54 | ClientHeight = 63 55 | ClientWidth = 421 56 | ItemIndex = 1 57 | Items.Strings = ( 58 | '&Never' 59 | '&Sometimes, if a good place to break is found' 60 | '&Usually, unless there is no acceptable place to break' 61 | ) 62 | TabOrder = 1 63 | end 64 | end 65 | -------------------------------------------------------------------------------- /Ui/Settings/frComments.lfm: -------------------------------------------------------------------------------- 1 | inherited fComments: TfComments 2 | TabOrder = 0 3 | DesignLeft = 148 4 | DesignTop = 150 5 | object cbRemoveEmptyDoubleSlashComments: TCheckBox[0] 6 | AnchorSideLeft.Control = Owner 7 | AnchorSideTop.Control = Owner 8 | Left = 6 9 | Height = 17 10 | Top = 6 11 | Width = 156 12 | BorderSpacing.Around = 6 13 | Caption = 'Remove empty ''//'' comments' 14 | TabOrder = 0 15 | end 16 | object cbRemoveEmptyCurlyBraceComments: TCheckBox[1] 17 | AnchorSideLeft.Control = Owner 18 | AnchorSideTop.Control = cbRemoveEmptyDoubleSlashComments 19 | AnchorSideTop.Side = asrBottom 20 | Left = 6 21 | Height = 17 22 | Top = 29 23 | Width = 161 24 | BorderSpacing.Around = 6 25 | Caption = 'Remove empty ''{ }'' comments' 26 | TabOrder = 1 27 | end 28 | end 29 | -------------------------------------------------------------------------------- /Ui/Settings/frComments.pas: -------------------------------------------------------------------------------- 1 | unit frComments; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is frComments.pas, released Nov 2003. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | uses 33 | StdCtrls, Classes, 34 | IDEOptionsIntf; 35 | 36 | type 37 | 38 | { TfComments } 39 | 40 | TfComments = class(TAbstractIDEOptionsEditor) 41 | cbRemoveEmptyDoubleSlashComments: TCheckBox; 42 | cbRemoveEmptyCurlyBraceComments: TCheckBox; 43 | public 44 | constructor Create(AOwner: TComponent); override; 45 | 46 | function GetTitle: String; override; 47 | procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override; 48 | procedure ReadSettings({%H-}AOptions: TAbstractIDEOptions); override; 49 | procedure WriteSettings({%H-}AOptions: TAbstractIDEOptions); override; 50 | class function SupportedOptionsClass: TAbstractIDEOptionsClass; override; 51 | end; 52 | 53 | implementation 54 | 55 | {$R *.lfm} 56 | 57 | uses 58 | JcfSettings, jcfuiconsts; 59 | 60 | constructor TfComments.Create(AOwner: TComponent); 61 | begin 62 | inherited; 63 | //fiHelpContext := HELP_CLARIFY_COMMENTS; 64 | end; 65 | 66 | function TfComments.GetTitle: String; 67 | begin 68 | Result := lisAlignComments; 69 | end; 70 | 71 | procedure TfComments.Setup(ADialog: TAbstractOptionsEditorDialog); 72 | begin 73 | cbRemoveEmptyDoubleSlashComments.Caption := 74 | lisCommentsRemoveEmptySlashComments; 75 | cbRemoveEmptyCurlyBraceComments.Caption := 76 | lisCommentsRemoveEmptyCurlyBracesComments; 77 | end; 78 | 79 | procedure TfComments.ReadSettings(AOptions: TAbstractIDEOptions); 80 | begin 81 | with FormatSettings.Comments do 82 | begin 83 | cbRemoveEmptyDoubleSlashComments.Checked := RemoveEmptyDoubleSlashComments; 84 | cbRemoveEmptyCurlyBraceComments.Checked := RemoveEmptyCurlyBraceComments; 85 | end; 86 | end; 87 | 88 | procedure TfComments.WriteSettings(AOptions: TAbstractIDEOptions); 89 | begin 90 | with FormatSettings.Comments do 91 | begin 92 | RemoveEmptyDoubleSlashComments := cbRemoveEmptyDoubleSlashComments.Checked; 93 | RemoveEmptyCurlyBraceComments := cbRemoveEmptyCurlyBraceComments.Checked; 94 | end; 95 | end; 96 | 97 | class function TfComments.SupportedOptionsClass: TAbstractIDEOptionsClass; 98 | begin 99 | Result := TFormatSettings; 100 | end; 101 | 102 | initialization 103 | RegisterIDEOptionsEditor(JCFOptionsGroup, TfComments, JCFOptionComments, JCFOptionClarify); 104 | end. 105 | -------------------------------------------------------------------------------- /Ui/Settings/frFiles.lfm: -------------------------------------------------------------------------------- 1 | inherited fFiles: TfFiles 2 | Height = 281 3 | Width = 338 4 | ClientHeight = 281 5 | ClientWidth = 338 6 | OnResize = FrameResize 7 | DesignLeft = 597 8 | DesignTop = 402 9 | object lblStatus: TLabel[0] 10 | Left = 8 11 | Height = 14 12 | Top = 42 13 | Width = 42 14 | Caption = 'lblStatus' 15 | ParentColor = False 16 | end 17 | object lblDate: TLabel[1] 18 | Left = 8 19 | Height = 14 20 | Top = 64 21 | Width = 34 22 | Caption = 'lblDate' 23 | ParentColor = False 24 | end 25 | object lblVersion: TLabel[2] 26 | Left = 8 27 | Height = 14 28 | Top = 88 29 | Width = 46 30 | Caption = 'lblVersion' 31 | ParentColor = False 32 | end 33 | object lblDescription: TLabel[3] 34 | Left = 8 35 | Height = 14 36 | Top = 114 37 | Width = 58 38 | Caption = 'Description:' 39 | ParentColor = False 40 | end 41 | object lblFormatFileName: TLabel[4] 42 | Left = 8 43 | Height = 14 44 | Top = 8 45 | Width = 88 46 | Caption = 'lblFormatFileName' 47 | ParentColor = False 48 | end 49 | object mDescription: TMemo[5] 50 | Left = 8 51 | Height = 89 52 | Top = 134 53 | Width = 301 54 | TabOrder = 0 55 | end 56 | end 57 | -------------------------------------------------------------------------------- /Ui/Settings/frIdentifierCapsSettings.lfm: -------------------------------------------------------------------------------- 1 | inherited fIdentifierCapsSettings: TfIdentifierCapsSettings 2 | Height = 230 3 | Width = 366 4 | ClientHeight = 230 5 | ClientWidth = 366 6 | OnResize = FrameResize 7 | TabOrder = 0 8 | DesignLeft = 656 9 | DesignTop = 326 10 | object Label1: TLabel[0] 11 | AnchorSideLeft.Control = Owner 12 | AnchorSideLeft.Side = asrCenter 13 | AnchorSideTop.Control = Owner 14 | Left = 95 15 | Height = 14 16 | Top = 0 17 | Width = 177 18 | Caption = 'Set capitalisation on these identifiers' 19 | ParentColor = False 20 | end 21 | object cbEnableAnyWords: TCheckBox[1] 22 | AnchorSideLeft.Control = Owner 23 | AnchorSideTop.Control = Owner 24 | Left = 6 25 | Height = 17 26 | Top = 6 27 | Width = 50 28 | BorderSpacing.Around = 6 29 | Caption = 'Enable' 30 | Checked = True 31 | OnClick = cbEnableAnyWordsClick 32 | State = cbChecked 33 | TabOrder = 0 34 | end 35 | object mWords: TMemo[2] 36 | AnchorSideLeft.Control = Owner 37 | AnchorSideTop.Control = cbEnableAnyWords 38 | AnchorSideTop.Side = asrBottom 39 | AnchorSideRight.Control = Owner 40 | AnchorSideRight.Side = asrBottom 41 | AnchorSideBottom.Control = Owner 42 | AnchorSideBottom.Side = asrBottom 43 | Left = 6 44 | Height = 195 45 | Top = 29 46 | Width = 354 47 | Align = alBottom 48 | Anchors = [akTop, akLeft, akRight, akBottom] 49 | BorderSpacing.Around = 6 50 | ScrollBars = ssVertical 51 | TabOrder = 1 52 | end 53 | end 54 | -------------------------------------------------------------------------------- /Ui/Settings/frNotIdentifierCapsSettings.lfm: -------------------------------------------------------------------------------- 1 | inherited fNotIdentifierCapsSettings: TfNotIdentifierCapsSettings 2 | Height = 232 3 | Width = 396 4 | ClientHeight = 232 5 | ClientWidth = 396 6 | OnResize = FrameResize 7 | TabOrder = 0 8 | DesignLeft = 689 9 | DesignTop = 570 10 | object Label1: TLabel[0] 11 | AnchorSideLeft.Control = Owner 12 | AnchorSideLeft.Side = asrCenter 13 | AnchorSideTop.Control = Owner 14 | Left = 99 15 | Height = 14 16 | Top = 0 17 | Width = 199 18 | Caption = 'Set capitalisation on these non-identifiers' 19 | ParentColor = False 20 | end 21 | object cbEnableAnyWords: TCheckBox[1] 22 | AnchorSideLeft.Control = Owner 23 | AnchorSideTop.Control = Owner 24 | Left = 6 25 | Height = 17 26 | Top = 6 27 | Width = 50 28 | BorderSpacing.Around = 6 29 | Caption = 'Enable' 30 | Checked = True 31 | OnClick = cbEnableAnyWordsClick 32 | State = cbChecked 33 | TabOrder = 0 34 | end 35 | object mWords: TMemo[2] 36 | AnchorSideLeft.Control = Owner 37 | AnchorSideTop.Control = cbEnableAnyWords 38 | AnchorSideTop.Side = asrBottom 39 | AnchorSideRight.Control = Owner 40 | AnchorSideRight.Side = asrBottom 41 | AnchorSideBottom.Control = Owner 42 | AnchorSideBottom.Side = asrBottom 43 | Left = 6 44 | Height = 197 45 | Top = 29 46 | Width = 384 47 | Align = alBottom 48 | Anchors = [akTop, akLeft, akRight, akBottom] 49 | BorderSpacing.Around = 6 50 | ScrollBars = ssVertical 51 | TabOrder = 1 52 | end 53 | end 54 | -------------------------------------------------------------------------------- /Ui/Settings/frObfuscateSettings.lfm: -------------------------------------------------------------------------------- 1 | inherited fObfuscateSettings: TfObfuscateSettings 2 | Height = 271 3 | Width = 275 4 | ClientHeight = 271 5 | ClientWidth = 275 6 | TabOrder = 0 7 | DesignLeft = 426 8 | DesignTop = 292 9 | object cbRemoveWhiteSpace: TCheckBox[0] 10 | AnchorSideLeft.Control = cbEnabled 11 | AnchorSideTop.Control = rgObfuscateCaps 12 | AnchorSideTop.Side = asrBottom 13 | Left = 6 14 | Height = 17 15 | Top = 133 16 | Width = 117 17 | BorderSpacing.Top = 6 18 | Caption = 'Remove &white space' 19 | Checked = True 20 | State = cbChecked 21 | TabOrder = 2 22 | end 23 | object cbRemoveComments: TCheckBox[1] 24 | AnchorSideLeft.Control = cbEnabled 25 | AnchorSideTop.Control = cbRemoveWhiteSpace 26 | AnchorSideTop.Side = asrBottom 27 | Left = 6 28 | Height = 17 29 | Top = 156 30 | Width = 108 31 | BorderSpacing.Top = 6 32 | Caption = 'Remove c&omments' 33 | Checked = True 34 | State = cbChecked 35 | TabOrder = 3 36 | end 37 | object rgObfuscateCaps: TRadioGroup[2] 38 | AnchorSideLeft.Control = cbEnabled 39 | AnchorSideTop.Control = cbEnabled 40 | AnchorSideTop.Side = asrBottom 41 | AnchorSideRight.Control = Owner 42 | AnchorSideRight.Side = asrBottom 43 | Left = 6 44 | Height = 98 45 | Top = 29 46 | Width = 263 47 | Anchors = [akTop, akLeft, akRight] 48 | AutoFill = True 49 | AutoSize = True 50 | BorderSpacing.Top = 6 51 | BorderSpacing.Right = 6 52 | Caption = 'Obfuscate word &caps' 53 | ChildSizing.LeftRightSpacing = 6 54 | ChildSizing.TopBottomSpacing = 6 55 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 56 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 57 | ChildSizing.ShrinkHorizontal = crsScaleChilds 58 | ChildSizing.ShrinkVertical = crsScaleChilds 59 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 60 | ChildSizing.ControlsPerLine = 1 61 | ClientHeight = 80 62 | ClientWidth = 259 63 | ItemIndex = 0 64 | Items.Strings = ( 65 | 'ALL CAPITALS' 66 | 'all lowercase' 67 | 'Mixed Case' 68 | 'Leave alone' 69 | ) 70 | TabOrder = 1 71 | end 72 | object cbRebreak: TCheckBox[3] 73 | AnchorSideLeft.Control = cbEnabled 74 | AnchorSideTop.Control = cbRemoveIndent 75 | AnchorSideTop.Side = asrBottom 76 | Left = 6 77 | Height = 17 78 | Top = 202 79 | Width = 82 80 | BorderSpacing.Top = 6 81 | Caption = 'Rebreak &lines' 82 | Checked = True 83 | State = cbChecked 84 | TabOrder = 5 85 | end 86 | object cbRemoveIndent: TCheckBox[4] 87 | AnchorSideLeft.Control = cbEnabled 88 | AnchorSideTop.Control = cbRemoveComments 89 | AnchorSideTop.Side = asrBottom 90 | Left = 6 91 | Height = 17 92 | Top = 179 93 | Width = 90 94 | BorderSpacing.Top = 6 95 | Caption = 'Remove &indent' 96 | Checked = True 97 | State = cbChecked 98 | TabOrder = 4 99 | end 100 | object cbEnabled: TCheckBox[5] 101 | AnchorSideLeft.Control = Owner 102 | AnchorSideTop.Control = Owner 103 | Left = 6 104 | Height = 17 105 | Top = 6 106 | Width = 97 107 | BorderSpacing.Around = 6 108 | Caption = '&Obfuscate mode' 109 | OnChange = cbEnabledChange 110 | TabOrder = 0 111 | end 112 | end 113 | -------------------------------------------------------------------------------- /Ui/Settings/frPreProcessor.lfm: -------------------------------------------------------------------------------- 1 | inherited fPreProcessor: TfPreProcessor 2 | Height = 282 3 | Width = 409 4 | ClientHeight = 282 5 | ClientWidth = 409 6 | OnResize = FrameResize 7 | TabOrder = 0 8 | DesignLeft = 627 9 | DesignTop = 292 10 | object lblSymbols: TLabel[0] 11 | AnchorSideLeft.Control = Owner 12 | AnchorSideTop.Control = cbEnable 13 | AnchorSideTop.Side = asrBottom 14 | Left = 6 15 | Height = 14 16 | Top = 29 17 | Width = 210 18 | BorderSpacing.Around = 6 19 | Caption = 'Symbols defined for conditional compilation:' 20 | ParentColor = False 21 | end 22 | object lblCompilerOptions: TLabel[1] 23 | AnchorSideLeft.Control = Owner 24 | AnchorSideTop.Control = mSymbols 25 | AnchorSideTop.Side = asrBottom 26 | Left = 6 27 | Height = 14 28 | Top = 140 29 | Width = 250 30 | BorderSpacing.Top = 6 31 | BorderSpacing.Around = 6 32 | Caption = 'Compiler options defined for conditional compilation:' 33 | ParentColor = False 34 | end 35 | object mSymbols: TMemo[2] 36 | AnchorSideLeft.Control = Owner 37 | AnchorSideTop.Control = lblSymbols 38 | AnchorSideTop.Side = asrBottom 39 | AnchorSideRight.Control = Owner 40 | AnchorSideRight.Side = asrBottom 41 | Left = 6 42 | Height = 79 43 | Top = 49 44 | Width = 397 45 | Anchors = [akTop, akLeft, akRight] 46 | BorderSpacing.Around = 6 47 | ScrollBars = ssVertical 48 | TabOrder = 1 49 | end 50 | object cbEnable: TCheckBox[3] 51 | AnchorSideLeft.Control = Owner 52 | AnchorSideTop.Control = Owner 53 | Left = 6 54 | Height = 17 55 | Top = 6 56 | Width = 154 57 | BorderSpacing.Around = 6 58 | Caption = 'Enable preprocessor parsing' 59 | Checked = True 60 | OnChange = cbEnableChange 61 | State = cbChecked 62 | TabOrder = 0 63 | end 64 | object mOptions: TMemo[4] 65 | AnchorSideLeft.Control = Owner 66 | AnchorSideTop.Control = lblCompilerOptions 67 | AnchorSideTop.Side = asrBottom 68 | AnchorSideRight.Control = Owner 69 | AnchorSideRight.Side = asrBottom 70 | AnchorSideBottom.Control = Owner 71 | AnchorSideBottom.Side = asrBottom 72 | Left = 6 73 | Height = 116 74 | Top = 160 75 | Width = 397 76 | Anchors = [akTop, akLeft, akRight, akBottom] 77 | BorderSpacing.Around = 6 78 | ScrollBars = ssVertical 79 | TabOrder = 2 80 | end 81 | end 82 | -------------------------------------------------------------------------------- /Ui/Settings/frReplace.lfm: -------------------------------------------------------------------------------- 1 | inherited fReplace: TfReplace 2 | Height = 358 3 | Width = 400 4 | ClientHeight = 358 5 | ClientWidth = 400 6 | OnResize = FrameResize 7 | TabOrder = 0 8 | DesignLeft = 305 9 | DesignTop = 198 10 | object lblWordList: TLabel[0] 11 | AnchorSideLeft.Control = Owner 12 | AnchorSideTop.Control = cbEnable 13 | AnchorSideTop.Side = asrBottom 14 | Left = 6 15 | Height = 14 16 | Top = 35 17 | Width = 47 18 | BorderSpacing.Top = 6 19 | BorderSpacing.Around = 6 20 | Caption = 'Word list:' 21 | ParentColor = False 22 | end 23 | object cbEnable: TCheckBox[1] 24 | AnchorSideLeft.Control = Owner 25 | AnchorSideTop.Control = Owner 26 | Left = 6 27 | Height = 17 28 | Top = 6 29 | Width = 130 30 | BorderSpacing.Around = 6 31 | Caption = 'Enable find and replace' 32 | OnClick = cbEnableClick 33 | TabOrder = 0 34 | end 35 | object mWords: TMemo[2] 36 | AnchorSideLeft.Control = Owner 37 | AnchorSideTop.Control = lblWordList 38 | AnchorSideTop.Side = asrBottom 39 | AnchorSideRight.Control = Owner 40 | AnchorSideRight.Side = asrBottom 41 | AnchorSideBottom.Control = Owner 42 | AnchorSideBottom.Side = asrBottom 43 | Left = 6 44 | Height = 297 45 | Top = 55 46 | Width = 388 47 | Anchors = [akTop, akLeft, akRight, akBottom] 48 | BorderSpacing.Around = 6 49 | TabOrder = 1 50 | end 51 | end 52 | -------------------------------------------------------------------------------- /Ui/Settings/frUnitCaps.lfm: -------------------------------------------------------------------------------- 1 | inherited frUnitNameCaps: TfrUnitNameCaps 2 | Width = 362 3 | ClientWidth = 362 4 | OnResize = FrameResize 5 | TabOrder = 0 6 | DesignLeft = 494 7 | DesignTop = 229 8 | object Label1: TLabel[0] 9 | AnchorSideLeft.Control = Owner 10 | AnchorSideLeft.Side = asrCenter 11 | AnchorSideTop.Control = Owner 12 | Left = 90 13 | Height = 14 14 | Top = 0 15 | Width = 182 16 | Caption = 'Set capitalisation on these unit names' 17 | ParentColor = False 18 | end 19 | object mWords: TMemo[1] 20 | AnchorSideLeft.Control = Owner 21 | AnchorSideTop.Control = cbEnableAnyWords 22 | AnchorSideTop.Side = asrBottom 23 | AnchorSideRight.Control = Owner 24 | AnchorSideRight.Side = asrBottom 25 | AnchorSideBottom.Control = Owner 26 | AnchorSideBottom.Side = asrBottom 27 | Left = 6 28 | Height = 205 29 | Top = 29 30 | Width = 350 31 | Align = alBottom 32 | Anchors = [akTop, akLeft, akRight, akBottom] 33 | BorderSpacing.Around = 6 34 | ScrollBars = ssVertical 35 | TabOrder = 1 36 | end 37 | object cbEnableAnyWords: TCheckBox[2] 38 | AnchorSideLeft.Control = Owner 39 | AnchorSideTop.Control = Owner 40 | Left = 6 41 | Height = 17 42 | Top = 6 43 | Width = 50 44 | BorderSpacing.Around = 6 45 | Caption = 'Enable' 46 | Checked = True 47 | State = cbChecked 48 | TabOrder = 0 49 | end 50 | end 51 | -------------------------------------------------------------------------------- /Ui/Settings/frUnitCaps.pas: -------------------------------------------------------------------------------- 1 | unit frUnitCaps; 2 | {(*} 3 | (*------------------------------------------------------------------------------ 4 | Delphi Code formatter source code 5 | 6 | The Original Code is frUnitCaps.pas 7 | The Initial Developer of the Original Code is Anthony Steele. 8 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 9 | All Rights Reserved. 10 | Contributor(s): Anthony Steele. 11 | 12 | The contents of this file are subject to the Mozilla Public License Version 1.1 13 | (the "License"). you may not use this file except in compliance with the License. 14 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 15 | 16 | Software distributed under the License is distributed on an "AS IS" basis, 17 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 18 | See the License for the specific language governing rights and limitations 19 | under the License. 20 | 21 | Alternatively, the contents of this file may be used under the terms of 22 | the GNU General Public License Version 2 or later (the "GPL") 23 | See http://www.gnu.org/licenses/gpl.html 24 | ------------------------------------------------------------------------------*) 25 | {*)} 26 | 27 | {$I JcfGlobal.inc} 28 | 29 | interface 30 | 31 | uses 32 | Classes, Controls, Forms, StdCtrls, 33 | IDEOptionsIntf; 34 | 35 | type 36 | 37 | { TfrUnitNameCaps } 38 | 39 | TfrUnitNameCaps = class(TAbstractIDEOptionsEditor) 40 | mWords: TMemo; 41 | cbEnableAnyWords: TCheckBox; 42 | Label1: TLabel; 43 | procedure FrameResize(Sender: TObject); 44 | public 45 | constructor Create(AOwner: TComponent); override; 46 | 47 | function GetTitle: String; override; 48 | procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override; 49 | procedure ReadSettings({%H-}AOptions: TAbstractIDEOptions); override; 50 | procedure WriteSettings({%H-}AOptions: TAbstractIDEOptions); override; 51 | class function SupportedOptionsClass: TAbstractIDEOptionsClass; override; 52 | end; 53 | 54 | implementation 55 | 56 | {$R *.lfm} 57 | 58 | uses 59 | JcfSettings, jcfuiconsts; 60 | 61 | constructor TfrUnitNameCaps.Create(AOwner: TComponent); 62 | begin 63 | inherited; 64 | 65 | end; 66 | 67 | function TfrUnitNameCaps.GetTitle: String; 68 | begin 69 | Result := lisCapsUnitNamesUnitNames; 70 | end; 71 | 72 | procedure TfrUnitNameCaps.Setup(ADialog: TAbstractOptionsEditorDialog); 73 | begin 74 | cbEnableAnyWords.Caption := lisCapsAnyWordEnable; 75 | Label1.Caption := lisCapsUnitNamesSetCapitalisationOnTheseUnitNames; 76 | end; 77 | 78 | procedure TfrUnitNameCaps.ReadSettings(AOptions: TAbstractIDEOptions); 79 | begin 80 | with FormatSettings.UnitNameCaps do 81 | begin 82 | cbEnableAnyWords.Checked := Enabled; 83 | mWords.Lines.Assign(Words); 84 | end; 85 | 86 | end; 87 | 88 | procedure TfrUnitNameCaps.WriteSettings(AOptions: TAbstractIDEOptions); 89 | begin 90 | with FormatSettings.UnitNameCaps do 91 | begin 92 | Enabled := cbEnableAnyWords.Checked; 93 | Words.Assign(mWords.Lines); 94 | end; 95 | 96 | end; 97 | 98 | class function TfrUnitNameCaps.SupportedOptionsClass: TAbstractIDEOptionsClass; 99 | begin 100 | Result := TFormatSettings; 101 | end; 102 | 103 | procedure TfrUnitNameCaps.FrameResize(Sender: TObject); 104 | begin 105 | mWords.Height := ClientHeight - 106 | (cbEnableAnyWords.Top + cbEnableAnyWords.Height + GUI_PAD); 107 | end; 108 | 109 | initialization 110 | RegisterIDEOptionsEditor(JCFOptionsGroup, TfrUnitNameCaps, JCFOptionUnitName, JCFOptionObjectPascal); 111 | end. 112 | -------------------------------------------------------------------------------- /Ui/Settings/frWarnings.lfm: -------------------------------------------------------------------------------- 1 | inherited fWarnings: TfWarnings 2 | Height = 255 3 | ClientHeight = 255 4 | OnResize = FrameResize 5 | TabOrder = 0 6 | DesignLeft = 254 7 | DesignTop = 175 8 | object Label1: TLabel[0] 9 | AnchorSideLeft.Control = Owner 10 | AnchorSideTop.Control = cbWarnUnusedParams 11 | AnchorSideTop.Side = asrBottom 12 | Left = 6 13 | Height = 14 14 | Top = 58 15 | Width = 168 16 | BorderSpacing.Top = 6 17 | BorderSpacing.Around = 6 18 | Caption = '&Ignore unused parameters named:' 19 | FocusControl = mIgnoreUnusedParams 20 | ParentColor = False 21 | end 22 | object cbWarningsOn: TCheckBox[1] 23 | AnchorSideLeft.Control = Owner 24 | AnchorSideTop.Control = Owner 25 | Left = 6 26 | Height = 17 27 | Top = 6 28 | Width = 80 29 | BorderSpacing.Around = 6 30 | Caption = '&Warnings On' 31 | OnChange = cbWarningsOnChange 32 | TabOrder = 0 33 | end 34 | object cbWarnUnusedParams: TCheckBox[2] 35 | AnchorSideLeft.Control = Owner 36 | AnchorSideTop.Control = cbWarningsOn 37 | AnchorSideTop.Side = asrBottom 38 | Left = 6 39 | Height = 17 40 | Top = 29 41 | Width = 140 42 | BorderSpacing.Around = 6 43 | Caption = 'Warn &unused parameters' 44 | OnChange = cbWarnUnusedParamsChange 45 | TabOrder = 1 46 | end 47 | object mIgnoreUnusedParams: TMemo[3] 48 | AnchorSideLeft.Control = Owner 49 | AnchorSideTop.Control = Label1 50 | AnchorSideTop.Side = asrBottom 51 | AnchorSideRight.Control = Owner 52 | AnchorSideRight.Side = asrBottom 53 | AnchorSideBottom.Control = Owner 54 | AnchorSideBottom.Side = asrBottom 55 | Left = 6 56 | Height = 171 57 | Top = 78 58 | Width = 308 59 | Anchors = [akTop, akLeft, akRight, akBottom] 60 | BorderSpacing.Around = 6 61 | ScrollBars = ssVertical 62 | TabOrder = 2 63 | end 64 | end 65 | -------------------------------------------------------------------------------- /Ui/fJcfErrorDisplay.dfm: -------------------------------------------------------------------------------- 1 | object ExceptionDialog: TExceptionDialog 2 | Left = 294 3 | Top = 195 4 | BorderIcons = [biSystemMenu] 5 | Caption = 'JCF Exception' 6 | ClientHeight = 180 7 | ClientWidth = 420 8 | Color = clBtnFace 9 | Font.Charset = ANSI_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -15 12 | Font.Name = 'Segoe UI' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Scaled = False 16 | OnCreate = FormCreate 17 | OnResize = FormResize 18 | PixelsPerInch = 96 19 | TextHeight = 20 20 | object btnOk: TButton 21 | Left = 155 22 | Top = 133 23 | Width = 100 24 | Height = 34 25 | Caption = '&OK' 26 | Default = True 27 | TabOrder = 0 28 | OnClick = btnOkClick 29 | end 30 | object mExceptionMessage: TMemo 31 | Left = 0 32 | Top = 0 33 | Width = 409 34 | Height = 124 35 | ParentColor = True 36 | ReadOnly = True 37 | TabOrder = 1 38 | end 39 | end 40 | -------------------------------------------------------------------------------- /Ui/fJcfErrorDisplay.lfm: -------------------------------------------------------------------------------- 1 | object ExceptionDialog: TExceptionDialog 2 | Left = 294 3 | Height = 180 4 | Top = 195 5 | Width = 420 6 | BorderIcons = [biSystemMenu] 7 | Caption = 'JCF Exception' 8 | ClientHeight = 180 9 | ClientWidth = 420 10 | Font.CharSet = ANSI_CHARSET 11 | Font.Height = -15 12 | Font.Name = 'Segoe UI' 13 | OnCreate = FormCreate 14 | OnResize = FormResize 15 | LCLVersion = '0.9.27' 16 | object btnOk: TButton 17 | Left = 155 18 | Height = 34 19 | Top = 133 20 | Width = 100 21 | Caption = '&OK' 22 | Default = True 23 | OnClick = btnOkClick 24 | TabOrder = 0 25 | end 26 | object mExceptionMessage: TMemo 27 | Left = 0 28 | Height = 124 29 | Top = 0 30 | Width = 409 31 | ReadOnly = True 32 | TabOrder = 1 33 | end 34 | end 35 | -------------------------------------------------------------------------------- /Utils/DragDrop/JCFDropTarget.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/Utils/DragDrop/JCFDropTarget.pas -------------------------------------------------------------------------------- /Utils/DragDrop/frDrop.dfm: -------------------------------------------------------------------------------- 1 | object FrameDrop: TFrameDrop 2 | Left = 0 3 | Top = 0 4 | Width = 320 5 | Height = 240 6 | TabOrder = 0 7 | TabStop = True 8 | end 9 | -------------------------------------------------------------------------------- /Utils/JcfFileUtils.pas: -------------------------------------------------------------------------------- 1 | unit JcfFileUtils; 2 | 3 | {(*} 4 | (*------------------------------------------------------------------------------ 5 | Delphi Code formatter source code 6 | 7 | The Original Code is JcfFileUtils.pas, released October 2001. 8 | The Initial Developer of the Original Code is Anthony Steele. 9 | Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele. 10 | All Rights Reserved. 11 | Contributor(s): Anthony Steele. 12 | 13 | The contents of this file are subject to the Mozilla Public License Version 1.1 14 | (the "License"). you may not use this file except in compliance with the License. 15 | You may obtain a copy of the License at http://www.mozilla.org/NPL/ 16 | 17 | Software distributed under the License is distributed on an "AS IS" basis, 18 | WITHOUT WARRANTY OF ANY KIND, either express or implied. 19 | See the License for the specific language governing rights and limitations 20 | under the License. 21 | 22 | Alternatively, the contents of this file may be used under the terms of 23 | the GNU General Public License Version 2 or later (the "GPL") 24 | See http://www.gnu.org/licenses/gpl.html 25 | ------------------------------------------------------------------------------*) 26 | {*)} 27 | 28 | {$I JcfGlobal.inc} 29 | 30 | interface 31 | 32 | { this unit is a wrapper for platform-specific file fns 33 | IE a way to get rid of those portability warnings 34 | and a place to put the equivalent linux fns } 35 | 36 | {$IFDEF FPC} 37 | uses Dialogs; 38 | {$ELSE} 39 | {$IFDEF WIN32} 40 | uses {$WARNINGS OFF} FileCtrl {$WARNINGS ON}; 41 | {$ENDIF} 42 | {$ENDIF} 43 | 44 | 45 | function FileIsReadOnly(const ps: string): boolean; 46 | 47 | implementation 48 | 49 | uses SysUtils; 50 | 51 | {$IFDEF FPC} 52 | 53 | // FPC version 54 | function FileIsReadOnly(const ps: string): boolean; 55 | var 56 | liAttr: integer; 57 | begin 58 | Assert(FileExists(ps)); 59 | {$WARNINGS OFF} 60 | liAttr := FileGetAttr(ps); 61 | Result := ((liAttr and faReadOnly) <> 0); 62 | {$WARNINGS ON} 63 | end; 64 | 65 | {$ELSE} 66 | {$IFDEF WIN32} 67 | 68 | // delphi-windows version 69 | function FileIsReadOnly(const ps: string): boolean; 70 | var 71 | liAttr: integer; 72 | begin 73 | Assert(FileExists(ps)); 74 | {$WARNINGS OFF} 75 | liAttr := FileGetAttr(ps); 76 | Result := ((liAttr and faReadOnly) <> 0); 77 | {$WARNINGS ON} 78 | end; 79 | 80 | {$ENDIF} 81 | {$IFDEF LINUX} 82 | // delphi-linux version 83 | This bit will not compile under linux yet 84 | as the above win32 fns will not work there. 85 | {$ENDIF} 86 | {$ENDIF} 87 | 88 | end. 89 | -------------------------------------------------------------------------------- /jcf_vscode.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/jcf_vscode.gif -------------------------------------------------------------------------------- /lazutils/FTL.TXT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/lazutils/FTL.TXT -------------------------------------------------------------------------------- /lazutils/Makefile.compiled: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /lazutils/Makefile.fpc: -------------------------------------------------------------------------------- 1 | # File generated automatically by Lazarus Package Manager 2 | # 3 | # Makefile.fpc for LazUtils 1.0 4 | # 5 | # This file was generated on 1-10-15 6 | 7 | [package] 8 | name=lazutils 9 | version=1.0 10 | 11 | [compiler] 12 | unittargetdir=lib/$(CPU_TARGET)-$(OS_TARGET) 13 | unitdir=../../packager/units/$(CPU_TARGET)-$(OS_TARGET) . 14 | options= -MObjFPC -Scghi -O1 -g -gl -l -vewnhibq $(DBG_OPTIONS) 15 | 16 | [target] 17 | units=lazutils.pas 18 | 19 | [clean] 20 | files=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) \ 21 | $(wildcard $(COMPILER_UNITTARGETDIR)/*$(PPUEXT)) \ 22 | $(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) \ 23 | $(wildcard $(COMPILER_UNITTARGETDIR)/*.lfm) \ 24 | $(wildcard $(COMPILER_UNITTARGETDIR)/*.res) \ 25 | $(wildcard $(COMPILER_UNITTARGETDIR)/*.compiled) \ 26 | $(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT)) 27 | [prerules] 28 | # LCL Platform 29 | ifndef LCL_PLATFORM 30 | ifeq ($(OS_TARGET),win32) 31 | LCL_PLATFORM=win32 32 | else 33 | ifeq ($(OS_TARGET),win64) 34 | LCL_PLATFORM=win32 35 | else 36 | ifeq ($(OS_TARGET),darwin) 37 | LCL_PLATFORM=carbon 38 | else 39 | LCL_PLATFORM=gtk2 40 | endif 41 | endif 42 | endif 43 | endif 44 | export LCL_PLATFORM 45 | 46 | DBG_OPTIONS= 47 | ifeq ($(OS_TARGET),darwin) 48 | DBG_OPTIONS=-gw 49 | endif 50 | 51 | [rules] 52 | .PHONY: cleartarget compiled all 53 | 54 | cleartarget: 55 | -$(DEL) $(COMPILER_UNITTARGETDIR)/lazutils$(PPUEXT) 56 | 57 | compiled: 58 | $(CPPROG) -f Makefile.compiled $(COMPILER_UNITTARGETDIR)/LazUtils.compiled 59 | 60 | all: cleartarget $(COMPILER_UNITTARGETDIR) lazutils$(PPUEXT) compiled 61 | 62 | distclean: clean 63 | ${DELTREE} lib/* 64 | -------------------------------------------------------------------------------- /lazutils/fpcadds.pas: -------------------------------------------------------------------------------- 1 | { 2 | ***************************************************************************** 3 | This file is part of LazUtils. 4 | 5 | See the file COPYING.modifiedLGPL.txt, included in this distribution, 6 | for details about the license. 7 | ***************************************************************************** 8 | } 9 | unit FPCAdds; 10 | 11 | {$mode objfpc}{$H+}{$inline on} 12 | 13 | {$i lazutils_defines.inc} 14 | 15 | interface 16 | 17 | uses 18 | Classes, SysUtils; 19 | 20 | type 21 | TStreamSeekType = int64; 22 | TMemStreamSeekType = PtrInt; 23 | TCompareMemSize = PtrUInt; 24 | PHandle = ^THandle; 25 | 26 | function StrToWord(const s: string): word; 27 | 28 | function AlignToPtr(const p: Pointer): Pointer; 29 | function AlignToInt(const p: Pointer): Pointer; 30 | 31 | implementation 32 | 33 | function StrToWord(const s: string): word; 34 | var 35 | p: Integer; 36 | begin 37 | Result:=0; 38 | p:=1; 39 | while (p<=length(s)) do begin 40 | Result:=Result*10+ord(s[p])-ord('0'); 41 | inc(p); 42 | end; 43 | end; 44 | 45 | function AlignToPtr(const p: Pointer): Pointer; 46 | begin 47 | {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT} 48 | Result := Align(p, SizeOf(Pointer)); 49 | {$ELSE} 50 | Result := p; 51 | {$ENDIF} 52 | end; 53 | 54 | function AlignToInt(const p: Pointer): Pointer; 55 | begin 56 | {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT} 57 | Result := Align(p, SizeOf(integer)); 58 | {$ELSE} 59 | Result := p; 60 | {$ENDIF} 61 | end; 62 | 63 | {$ifdef UTF8_RTL} 64 | initialization 65 | SetMultiByteConversionCodePage(CP_UTF8); 66 | // SetMultiByteFileSystemCodePage(CP_UTF8); not needed, this is the default under Windows 67 | SetMultiByteRTLFileSystemCodePage(CP_UTF8); 68 | {$IFEND} 69 | 70 | end. 71 | -------------------------------------------------------------------------------- /lazutils/laz_dom.pas: -------------------------------------------------------------------------------- 1 | { 2 | ********************************************************************** 3 | This file is part of LazUtils. 4 | It is copied from Free Component Library. 5 | 6 | See the file COPYING.FPC, included in this distribution, 7 | for details about the license. 8 | ********************************************************************** 9 | 10 | } 11 | 12 | unit Laz_DOM; 13 | 14 | {$MODE objfpc}{$H+} 15 | 16 | interface 17 | 18 | uses 19 | SysUtils, Classes, laz2_DOM; 20 | 21 | type 22 | TDOMImplementation = laz2_DOM.TDOMImplementation; 23 | TDOMDocumentFragment = laz2_DOM.TDOMDocumentFragment; 24 | TDOMDocument = laz2_DOM.TDOMDocument; 25 | TDOMNode = laz2_DOM.TDOMNode; 26 | TDOMNodeList = laz2_DOM.TDOMNodeList; 27 | TDOMNamedNodeMap = laz2_DOM.TDOMNamedNodeMap; 28 | TDOMCharacterData = laz2_DOM.TDOMCharacterData; 29 | TDOMAttr = laz2_DOM.TDOMAttr; 30 | TDOMElement = laz2_DOM.TDOMElement; 31 | TDOMText = laz2_DOM.TDOMText; 32 | TDOMComment = laz2_DOM.TDOMComment; 33 | TDOMCDATASection = laz2_DOM.TDOMCDATASection; 34 | TDOMDocumentType = laz2_DOM.TDOMDocumentType; 35 | TDOMNotation = laz2_DOM.TDOMNotation; 36 | TDOMEntity = laz2_DOM.TDOMEntity; 37 | TDOMEntityReference = laz2_DOM.TDOMEntityReference; 38 | TDOMProcessingInstruction = laz2_DOM.TDOMProcessingInstruction; 39 | 40 | DOMString = laz2_DOM.DOMString; 41 | DOMPChar = laz2_DOM.DOMPChar; 42 | 43 | EDOMError = laz2_DOM.EDOMError; 44 | 45 | implementation 46 | 47 | end. 48 | 49 | 50 | -------------------------------------------------------------------------------- /lazutils/laz_xmlcfg.pas: -------------------------------------------------------------------------------- 1 | { 2 | ********************************************************************** 3 | This file is part of LazUtils. 4 | It is copied from Free Component Library and was adapted to use 5 | UTF8 strings instead of widestrings. 6 | 7 | See the file COPYING.modifiedLGPL.txt, included in this distribution, 8 | for details about the license. 9 | ********************************************************************** 10 | 11 | Implementation of TXMLConfig class 12 | Copyright (c) 1999 - 2001 by Sebastian Guenther, sg@freepascal.org 13 | 14 | TXMLConfig enables applications to use XML files for storing their 15 | configuration data 16 | } 17 | 18 | {$MODE objfpc} 19 | {$H+} 20 | 21 | unit Laz_XMLCfg; 22 | 23 | interface 24 | 25 | uses 26 | Classes, sysutils, Laz2_XMLCfg; 27 | 28 | type 29 | TXMLConfig = Laz2_XMLCfg.TXMLConfig; 30 | TRttiXMLConfig = Laz2_XMLCfg.TRttiXMLConfig; 31 | 32 | implementation 33 | 34 | end. 35 | -------------------------------------------------------------------------------- /lazutils/laz_xmlwrite.pas: -------------------------------------------------------------------------------- 1 | { 2 | ********************************************************************** 3 | This file is part of LazUtils. 4 | It is copied from Free Component Library. 5 | 6 | See the file COPYING.FPC, included in this distribution, 7 | for details about the license. 8 | ********************************************************************** 9 | 10 | } 11 | 12 | unit Laz_XMLWrite; 13 | 14 | {$MODE objfpc}{$H+} 15 | {$inline on} 16 | 17 | interface 18 | 19 | uses Classes, laz2_XMLWrite, laz2_DOM; 20 | 21 | const 22 | xwfOldXMLWrite = [xwfSpecialCharsInAttributeValue]; 23 | 24 | procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String); overload; 25 | procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); overload; 26 | procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream); overload; 27 | 28 | procedure WriteXML(Element: TDOMNode; const AFileName: String); overload; 29 | procedure WriteXML(Element: TDOMNode; var AFile: Text); overload; 30 | procedure WriteXML(Element: TDOMNode; AStream: TStream); overload; 31 | 32 | implementation 33 | 34 | procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String); 35 | begin 36 | laz2_XMLWrite.WriteXMLFile(doc,AFileName,xwfOldXMLWrite); 37 | end; 38 | 39 | procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); 40 | begin 41 | laz2_XMLWrite.WriteXMLFile(doc,AFile,xwfOldXMLWrite); 42 | end; 43 | 44 | procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream); 45 | begin 46 | laz2_XMLWrite.WriteXMLFile(doc,AStream,xwfOldXMLWrite); 47 | end; 48 | 49 | procedure WriteXML(Element: TDOMNode; const AFileName: String); 50 | begin 51 | laz2_XMLWrite.WriteXML(Element,AFileName,xwfOldXMLWrite); 52 | end; 53 | 54 | procedure WriteXML(Element: TDOMNode; var AFile: Text); 55 | begin 56 | laz2_XMLWrite.WriteXML(Element,AFile,xwfOldXMLWrite); 57 | end; 58 | 59 | procedure WriteXML(Element: TDOMNode; AStream: TStream); 60 | begin 61 | laz2_XMLWrite.WriteXML(Element,AStream,xwfOldXMLWrite); 62 | end; 63 | 64 | end. 65 | -------------------------------------------------------------------------------- /lazutils/lazdbglog.pas: -------------------------------------------------------------------------------- 1 | { 2 | ********************************************************************** 3 | This file is part of LazUtils. 4 | 5 | See the file COPYING.modifiedLGPL.txt, included in this distribution, 6 | for details about the license. 7 | ********************************************************************** 8 | } 9 | unit LazDbgLog; 10 | 11 | {$mode objfpc}{$H+} 12 | 13 | interface 14 | 15 | uses 16 | Classes, SysUtils; 17 | 18 | function MemSizeString(const s: string): PtrUInt; 19 | function MemSizeFPList(const List: TFPList): PtrUInt; 20 | function GetStringRefCount(const s: string): PtrInt; 21 | 22 | implementation 23 | 24 | function MemSizeString(const s: string): PtrUInt; 25 | begin 26 | Result:=length(s); 27 | if s<>'' then 28 | inc(Result,SizeOf(Pointer)*4); 29 | end; 30 | 31 | function MemSizeFPList(const List: TFPList): PtrUInt; 32 | begin 33 | if List=nil then exit(0); 34 | Result:=PtrUInt(List.InstanceSize) 35 | +PtrUInt(List.Capacity)*SizeOf(Pointer); 36 | end; 37 | 38 | function GetStringRefCount(const s: string): PtrInt; 39 | begin 40 | if s='' then 41 | Result:=-1 42 | else 43 | Result:=PPtrInt(s)[-2]; 44 | end; 45 | 46 | end. 47 | 48 | -------------------------------------------------------------------------------- /lazutils/lazutils.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit LazUtils; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | AvgLvlTree, DynamicArray, DynHashArray, DynQueue, EasyLazFreeType, 12 | ExtendedStrings, FileUtil, FPCAdds, Laz2_DOM, Laz2_XMLCfg, laz2_XMLRead, 13 | laz2_xmlutils, laz2_XMLWrite, laz2_xpath, Laz_DOM, Laz_XMLCfg, Laz_XMLRead, 14 | Laz_XMLStreaming, Laz_XMLWrite, LazClasses, lazCollections, 15 | LazConfigStorage, LazDbgLog, lazfglhash, LazFileCache, LazFileUtils, 16 | LazFreeType, LazFreeTypeFontCollection, LazFreeTypeFPImageDrawer, 17 | LazLinkedList, LazLogger, LazLoggerBase, LazLoggerDummy, LazLoggerProfiling, 18 | LazMethodList, LazUnicode, LazUTF16, LazUTF8, LazUTF8Classes, 19 | LazUTF8SysUtils, LazUtilities, LazUtilsStrConsts, LConvEncoding, lcsvutils, 20 | LookupStringList, Maps, Masks, PasWString, StringHashList, TextStrings, 21 | Translations, TTCache, TTCalc, TTCMap, TTDebug, TTError, TTFile, TTGLoad, 22 | TTInterp, TTLoad, TTMemory, TTObjs, TTProfile, TTRASTER, TTTables, TTTypes, 23 | UTF8Process, Laz_AVL_Tree, LazarusPackageIntf; 24 | 25 | implementation 26 | 27 | procedure Register; 28 | begin 29 | end; 30 | 31 | initialization 32 | RegisterPackage('LazUtils', @Register); 33 | end. 34 | -------------------------------------------------------------------------------- /lazutils/lazutils_defines.inc: -------------------------------------------------------------------------------- 1 | // Add defines here. This file should be included in all LazUtils units headers 2 | 3 | 4 | {$undef UTF8_RTL} // FPC >= 2.7.1 with codepages and default string = CP_UTF8 5 | {$undef ACP_RTL} // FPC >= 2.7.1 with codepages and default string = CP_ACP 6 | {$undef NO_CP_RTL} // FPC < 2.7.1 before string codepages 7 | 8 | 9 | {$ifdef FPC_HAS_CPSTRING} 10 | {$ifndef DisableUTF8RTL} 11 | {$define UTF8_RTL} 12 | {$else DisableUTF8RTL} 13 | {$define ACP_RTL} 14 | {$endif DisableUTF8RTL} 15 | {$else FPC_HAS_CPSTRING} 16 | {$define NO_CP_RTL} 17 | {$undef DisableUTF8RTL} 18 | {$endif FPC_HAS_CPSTRING} 19 | -------------------------------------------------------------------------------- /lazutils/lazutilsstrconsts.pas: -------------------------------------------------------------------------------- 1 | { 2 | ***************************************************************************** 3 | This file is part of LazUtils. 4 | 5 | See the file COPYING.modifiedLGPL.txt, included in this distribution, 6 | for details about the license. 7 | ***************************************************************************** 8 | 9 | This unit contains all resource strings from LazUtils. 10 | } 11 | unit LazUtilsStrConsts; 12 | 13 | {$mode objfpc}{$H+} 14 | 15 | interface 16 | 17 | resourceString 18 | lrsModified = ' modified '; 19 | lrsInvalidCharSet = 'The char set in mask "%s" is not valid!'; 20 | lrsSize = ' size '; 21 | lrsFileDoesNotExist = 'file "%s" does not exist'; 22 | lrsFileIsADirectoryAndNotAnExecutable = 'file "%s" is a directory and not an' 23 | +' executable'; 24 | lrsReadAccessDeniedFor = 'read access denied for %s'; 25 | lrsADirectoryComponentInDoesNotExistOrIsADanglingSyml2 = 'a directory ' 26 | +'component in %s does not exist or is a dangling symlink'; 27 | lrsADirectoryComponentInIsNotADirectory2 = 'a directory component in %s is ' 28 | +'not a directory'; 29 | lrsADirectoryComponentInDoesNotExistOrIsADanglingSyml = 'a directory ' 30 | +'component in %s does not exist or is a dangling symlink'; 31 | lrsADirectoryComponentInIsNotADirectory = 'a directory component in %s is ' 32 | +'not a directory'; 33 | lrsInsufficientMemory = 'insufficient memory'; 34 | lrsHasACircularSymbolicLink = '%s has a circular symbolic link'; 35 | lrsIsNotASymbolicLink = '%s is not a symbolic link'; 36 | lrsIsNotExecutable = '%s is not executable'; 37 | lrsUnableToCreateConfigDirectoryS = 'Unable to create config directory "%s"'; 38 | lrsProgramFileNotFound = 'program file not found %s'; 39 | lrsCanNotExecute = 'can not execute %s'; 40 | lrsListMustBeEmpty = 'List must be empty'; 41 | lrsListIndexExceedsBounds = 'List index exceeds bounds (%d)'; 42 | 43 | // XPath 44 | lrsNodeSet = 'node set'; 45 | lrsBoolean = 'boolean'; 46 | lrsNumber = 'number'; 47 | lrsString = 'string'; 48 | lrsVarNoConversion = 'Conversion from %s to %s not possible'; 49 | lrsScannerUnclosedString = 'String literal was not closed'; 50 | lrsScannerInvalidChar = 'Invalid character'; 51 | lrsScannerMalformedQName = 'Expected "*" or local part after colon'; 52 | lrsScannerExpectedVarName = 'Expected variable name after "$"'; 53 | lrsParserExpectedLeftBracket = 'Expected "("'; 54 | lrsParserExpectedRightBracket = 'Expected ")"'; 55 | lrsParserBadAxisName = 'Invalid axis name'; 56 | lrsParserBadNodeType = 'Invalid node type'; 57 | lrsParserExpectedRightSquareBracket = 'Expected "]" after predicate'; 58 | lrsParserInvalidPrimExpr = 'Invalid primary expression'; 59 | lrsParserGarbageAfterExpression = 'Unrecognized input after expression'; 60 | lrsParserInvalidNodeTest = 'Invalid node test (syntax error)'; 61 | lrsEvalUnknownFunction = 'Unknown function: "%s"'; 62 | lrsEvalUnknownVariable = 'Unknown variable: "%s"'; 63 | lrsEvalInvalidArgCount = 'Invalid number of function arguments'; 64 | 65 | implementation 66 | 67 | end. 68 | 69 | -------------------------------------------------------------------------------- /lazutils/ttcalc2.inc: -------------------------------------------------------------------------------- 1 | (******************************************************************* 2 | * 3 | * TTCalc2.Inc 1.2 4 | * 5 | * Arithmetic and Vectorial Computations (inline assembly) 6 | * This version is used for the OS/2 Virtual Pascal compiler 7 | * 8 | * Copyright 1996 David Turner, Robert Wilhelm and Werner Lemberg 9 | * 10 | * This file is part of the FreeType project, and may only be used 11 | * modified and distributed under the terms of the FreeType project 12 | * license, LICENSE.TXT. By continuing to use, modify or distribute 13 | * this file you indicate that you have read the license and 14 | * understand and accept it fully. 15 | * 16 | * NOTES : All vector operations were moved to the interpreter 17 | * 18 | ******************************************************************) 19 | 20 | (**********************************************************) 21 | (* *) 22 | (* The following routines are inline assembly, they are *) 23 | (* thus processor and bitness specific. Replace them *) 24 | (* with your own if you want to port the TrueType Engine *) 25 | 26 | (* We need unsigned longints to perform correctly our additions *) 27 | (* we include inline assembly to get them, baaahhh .. *) 28 | 29 | (**********************************************************) 30 | (* 64 Bit Addition *) 31 | 32 | procedure Add64( var X, Y, Z : Int64 ); assembler; 33 | {&USES ebx, edx} 34 | asm 35 | mov ebx,[X].dword 36 | mov eax,[ebx] 37 | mov edx,[ebx+4] 38 | 39 | mov ebx,[Y].dword 40 | add eax,[ebx] 41 | adc edx,[ebx+4] 42 | 43 | mov ebx,[Z].dword 44 | mov [ebx],eax 45 | mov [ebx+4],edx 46 | end; 47 | 48 | 49 | (**********************************************************) 50 | (* 64 Bit Substraction *) 51 | 52 | procedure Sub64( var X, Y, Z : Int64 ); assembler; 53 | {&USES ebx, edx} 54 | asm 55 | mov ebx,[X].dword 56 | mov eax,[ebx] 57 | mov edx,[ebx+4] 58 | 59 | mov ebx,[Y].dword 60 | sub eax,[ebx] 61 | sbb edx,[ebx+4] 62 | 63 | mov ebx,[Z].dword 64 | mov [ebx],eax 65 | mov [ebx+4],edx 66 | end; 67 | 68 | 69 | (**********************************************************) 70 | (* Multiply two Int32 to an Int64 *) 71 | 72 | procedure MulTo64( X, Y : Int32; var Z : Int64 ); assembler; 73 | {&USES ebx, edx } 74 | asm 75 | mov ebx,[Z].dword 76 | mov eax,[X] 77 | imul dword ptr [Y] 78 | mov [ebx],eax 79 | mov [ebx+4],edx 80 | end; 81 | 82 | 83 | (**********************************************************) 84 | (* Divide an Int64 by an Int32 *) 85 | 86 | function Div64by32( var X : Int64; Y : Int32 ) : Int32; assembler; 87 | {&USES ebx, edx} 88 | asm 89 | mov ebx, [X].dword 90 | mov eax, [ebx] 91 | mov edx, [ebx+4] 92 | idiv dword ptr [Y] 93 | end; 94 | 95 | procedure DivMod64by32( var X : Int64; Y : Int32; var Q, R : Int32 ); 96 | assembler; {&USES ebx, edx} 97 | asm 98 | mov ebx, [X].dword 99 | mov eax, [ebx] 100 | mov edx, [ebx+4] 101 | idiv dword ptr [Y] 102 | mov ebx, [Q].dword 103 | mov [ebx], eax 104 | mov ebx, [R].dword 105 | mov [ebx], edx 106 | end; 107 | 108 | -------------------------------------------------------------------------------- /lazutils/ttcalc3.inc: -------------------------------------------------------------------------------- 1 | (******************************************************************* 2 | * 3 | * TTCalc3.Inc 1.2 4 | * 5 | * Arithmetic and Vectorial Computations (inline assembly) 6 | * This version is used for Delphi 2 7 | * 8 | * Copyright 1996 David Turner, Robert Wilhelm and Werner Lemberg 9 | * 10 | * This file is part of the FreeType project, and may only be used 11 | * modified and distributed under the terms of the FreeType project 12 | * license, LICENSE.TXT. By continuing to use, modify or distribute 13 | * this file you indicate that you have read the license and 14 | * understand and accept it fully. 15 | * 16 | * NOTES : All vector operations were moved to the interpreter 17 | * 18 | ******************************************************************) 19 | 20 | (**********************************************************) 21 | (* *) 22 | (* The following routines are inline assembly, they are *) 23 | (* thus processor and bitness specific. Replace them *) 24 | (* with your own if you want to port the TrueType Engine *) 25 | 26 | (* NOTE : Delphi seems to use the eax, edx then ecx registers to pass *) 27 | (* the first three parameters *) 28 | 29 | (**********************************************************) 30 | (* 64 Bit Addition *) 31 | 32 | procedure Add64( var X, Y, Z : Int64 ); assembler; 33 | asm 34 | push ebx 35 | push esi 36 | mov ebx, [ eax ] 37 | mov esi, [eax+4] 38 | add ebx, [ edx ] 39 | adc esi, [edx+4] 40 | mov [ ecx ], ebx 41 | mov [ecx+4], esi 42 | pop esi 43 | pop ebx 44 | end; 45 | 46 | 47 | (**********************************************************) 48 | (* 64 Bit Substraction *) 49 | 50 | procedure Sub64( var X, Y, Z : Int64 ); assembler; 51 | asm 52 | push ebx 53 | push esi 54 | mov ebx, [ eax ] 55 | mov esi, [eax+4] 56 | sub ebx, [ edx ] 57 | sbb esi, [edx+4] 58 | mov [ ecx ], ebx 59 | mov [ecx+4], esi 60 | pop esi 61 | pop ebx 62 | end; 63 | 64 | 65 | (**********************************************************) 66 | (* Multiply two Int32 to an Int64 *) 67 | 68 | procedure MulTo64( X, Y : Int32; var Z : Int64 ); assembler; 69 | asm 70 | imul edx 71 | mov [ ecx ],eax 72 | mov [ecx+4],edx 73 | end; 74 | 75 | (**********************************************************) 76 | (* Divide an Int64 by an Int32 *) 77 | 78 | function Div64by32( var X : Int64; Y : Int32 ) : Int32; assembler; 79 | asm 80 | mov ecx, edx 81 | mov edx, [eax+4].dword 82 | mov eax, [ eax ].dword 83 | idiv ecx 84 | end; 85 | 86 | procedure DivMod64by32( var X : Int64; Y : Int32; var Q, R : Int32 ); 87 | assembler; 88 | asm 89 | push ebx 90 | mov ebx, edx 91 | mov edx, [eax+4].dword 92 | mov eax, [ eax ].dword 93 | idiv ebx 94 | mov [ecx], eax 95 | mov ebx, R 96 | mov [ebx], edx 97 | pop ebx 98 | end; 99 | 100 | -------------------------------------------------------------------------------- /lazutils/ttconfig.inc: -------------------------------------------------------------------------------- 1 | (* *) 2 | (* TTConfig.Inc *) 3 | (* *) 4 | (* This file contains several definition pragmas that are used to *) 5 | (* build several versions of the library. Each constant is commented *) 6 | 7 | (* Define the FREETYPE_DEBUG constant if you want the library dumping trace *) 8 | (* information to the standard error output. *) 9 | { $DEFINE FREETYPE_DEBUG} 10 | 11 | 12 | (* Define the ASSERT constant if you want to generate runtime integrity *) 13 | (* checks within the library. Most of the checks will panic and stop the *) 14 | (* the program when failed.. *) 15 | { $DEFINE ASSERT} 16 | 17 | 18 | (* Define the INLINE constant if you want to use inlining when provided *) 19 | (* by your compiler. Currently, only Virtual Pascal does *) 20 | {$IFDEF VIRTUALPASCAL} 21 | {$DEFINE INLINE} 22 | {$ENDIF} 23 | 24 | 25 | (* Define the USE32 constant on 32-bit systems. Virtual Pascal *) 26 | (* always define it by default. Now set for Delphi 2 and 3 *) 27 | {$IFDEF WIN32} 28 | {$DEFINE USE32} 29 | {$ENDIF} 30 | 31 | (* FreeType doesn't compile on old Pascal compilers that do not allow *) 32 | (* inline assembly like Turbo Pascal 5.5 and below *) 33 | {$IFDEF VER50} 34 | ERROR : FreeType cannot be compiled with something older than Turbo Pascal 6.0 35 | {$ENDIF} 36 | {$IFDEF VER55} 37 | ERROR : FreeType cannot be compiled with something older than Turbo Pascal 6.0 38 | {$ENDIF} 39 | 40 | (* Define the BORLANDPASCAL constant whenever you're using a DOS-based *) 41 | (* version of Turbo or Borland Pascal. *) 42 | {$IFDEF VER60} 43 | {$DEFINE BORLANDPASCAL} 44 | {$ENDIF} 45 | {$IFDEF VER70} 46 | {$DEFINE BORLANDPASCAL} 47 | {$ENDIF} 48 | 49 | (* Define DELPHI16 when compiled in the 16_bit version of Delphi *) 50 | {$IFDEF VER80} 51 | {$DEFINE DELPHI16} 52 | {$ENDIF} 53 | 54 | (* Define DELPHI32 when compiled in any 32-bit version of Delphi *) 55 | {$IFDEF VER90} (* for Delphi 2 *) 56 | {$DEFINE DELPHI32} 57 | {$ENDIF} 58 | {$IFDEF VER100} (* for Delphi 3 *) 59 | {$DEFINE DELPHI32} 60 | {$ENDIF} 61 | {$IFDEF VER110} (* for Borland C++ Builder 3 *) 62 | {$DEFINE DELPHI32} 63 | {$ENDIF} 64 | {$IFDEF VER120} (* for Delphi 4 *) 65 | {$DEFINE DELPHI32} 66 | {$ENDIF} 67 | {$IFDEF VER125} (* for Borland C++ Builder 4 *) 68 | {$DEFINE DELPHI32} 69 | {$ENDIF} 70 | 71 | (* I don't have Delphi 5, I hope this will work *) 72 | {$IFDEF VER130} 73 | {$DEFINE DELPHI32} 74 | {$ENDIF} 75 | 76 | (* Free Pascal options *) 77 | 78 | (* Asm error in Mac: ttraster_sweep.inc(51,30) Error: Generating PIC, but reference is not PIC-safe *) 79 | {$IFNDEF DARWIN} 80 | {$IFDEF CPUI386} 81 | {$DEFINE VERTICAL_SWEEP_SPAN_ASM} 82 | {$ENDIF} 83 | {$ENDIF} 84 | 85 | 86 | -------------------------------------------------------------------------------- /lazutils/tterror.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************* 2 | * 3 | * tterror.pas 1.0 4 | * 5 | * Simple Error management unit 6 | * 7 | * Copyright 1996, 1997 by 8 | * David Turner, Robert Wilhelm, and Werner Lemberg. 9 | * 10 | * This file is part of the FreeType project, and may only be used 11 | * modified and distributed under the terms of the FreeType project 12 | * license, LICENSE.TXT. By continuing to use, modify or distribute 13 | * this file you indicate that you have read the license and 14 | * understand and accept it fully. 15 | * 16 | ******************************************************************) 17 | 18 | unit TTError; 19 | 20 | interface 21 | 22 | uses TTTypes; 23 | 24 | procedure Check_Error( error : Integer ); 25 | 26 | procedure Panic1( message : String ); 27 | procedure Trace1( message : String ); 28 | 29 | const 30 | 31 | Err_Ras_None = 0; 32 | Err_Ras_NotIni = -2; (* Rasterizer not Initialized *) 33 | Err_Ras_Overflow = -3; (* Profile Table Overflow *) 34 | Err_Ras_Neg_H = -4; (* Negative Height encountered ! *) 35 | Err_Ras_Invalid = -5; (* Invalid value encountered ! *) 36 | Err_Ras_Invalid_Contours = -6; 37 | 38 | 39 | (* The Pascal version of the library doesn't support multiple *) 40 | (* threads. We use a global error variable, called simply "error" *) 41 | (* to report all defects. The various functions return an error *) 42 | (* condition, which can be either Success (false) or Failure (true) *) 43 | 44 | (* Note that the use of macros in the C version to automate error *) 45 | (* reporting makes the two source trees very similar, even if they *) 46 | (* differ from some design points like this one *) 47 | 48 | var 49 | error : integer; 50 | 51 | implementation 52 | 53 | 54 | procedure Panic1( message : String ); 55 | begin 56 | writeln( message ); 57 | halt(1); 58 | end; 59 | 60 | 61 | procedure Trace1( message : String ); 62 | begin 63 | writeln( message ); 64 | end; 65 | 66 | 67 | procedure Check_Error( error : Integer ); 68 | var 69 | num : String[4]; 70 | begin 71 | if error <> TT_Err_Ok then 72 | begin 73 | str( -error:3, num ); 74 | Panic1( 'Error code = ' + num ); 75 | end; 76 | end; 77 | 78 | end. 79 | 80 | -------------------------------------------------------------------------------- /lazutils/ttinterp.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/lazutils/ttinterp.pas -------------------------------------------------------------------------------- /lazutils/ttobjs.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/git-bee/jcf-cli/5711a5268ad54600a961d31d5e72ed765deb84bc/lazutils/ttobjs.pas -------------------------------------------------------------------------------- /lazutils/unixfileutil.inc: -------------------------------------------------------------------------------- 1 | {%MainUnit fileutil.pas} 2 | 3 | 4 | function ExtractShortPathNameUTF8(const FileName: String): String; 5 | begin 6 | Result:=SysToUTF8(SysUtils.ExtractShortPathName(UTF8ToSys(FileName))); 7 | end; 8 | 9 | -------------------------------------------------------------------------------- /lazutils/unixlazutf8.inc: -------------------------------------------------------------------------------- 1 | {%MainUnit lazutf8.pas} 2 | 3 | function ConsoleToUTF8(const s: string): string;// converts UTF8 string to console encoding (used by Write, WriteLn) 4 | begin 5 | Result := SysToUTF8(S); 6 | end; 7 | 8 | function UTF8ToConsole(const s: string): string; 9 | begin 10 | Result := UTF8ToSys(s); 11 | end; 12 | 13 | function WinCPToUTF8(const s: string): string; 14 | begin 15 | if NeedRTLAnsi and (not IsASCII(s)) then 16 | begin 17 | Result:=AnsiToUTF8(s); 18 | {$ifdef FPC_HAS_CPSTRING} 19 | // prevent UTF8 codepage appear in the strings - we don't need codepage 20 | // conversion magic in LCL code 21 | SetCodePage(RawByteString(Result), StringCodePage(s), False); 22 | {$endif} 23 | end 24 | else 25 | Result:=s; 26 | end; 27 | 28 | function UTF8ToWinCP(const s: string): string; 29 | begin 30 | if NeedRTLAnsi and (not IsASCII(s)) then 31 | Result:=UTF8ToAnsi(s) 32 | else 33 | Result:=s; 34 | end; 35 | 36 | function ParamStrUTF8(Param: Integer): string; 37 | begin 38 | Result:=SysToUTF8(ObjPas.ParamStr(Param)); 39 | end; 40 | 41 | procedure InitLazUtf8; 42 | begin 43 | //dummy procedure 44 | end; 45 | 46 | procedure FinalizeLazUTF8; 47 | begin 48 | //dummy procedure 49 | end; 50 | 51 | -------------------------------------------------------------------------------- /lazutils/winfileutil.inc: -------------------------------------------------------------------------------- 1 | {%MainUnit fileutil.pas} 2 | 3 | function ExtractShortPathNameUTF8(const FileName: String): String; 4 | var 5 | lPathSize: DWORD; 6 | WideFileName, WideResult: UnicodeString; 7 | begin 8 | // WinCE doesnt have this concept 9 | {$ifdef WinCE} 10 | Result := FileName; 11 | {$else} 12 | if Win32MajorVersion >= 5 then 13 | begin 14 | WideFileName := UTF8ToUTF16(FileName); 15 | SetLength(WideResult,Max_Path); 16 | lPathSize := GetShortPathNameW(PWideChar(WideFileName), PWideChar(WideResult), Length(WideResult)); 17 | SetLength(WideResult,lPathSize); 18 | Result := UTF16ToUTF8(WideResult); 19 | end 20 | else 21 | Result:=LazUTF8.SysToUTF8(SysUtils.ExtractShortPathName(LazUTF8.UTF8ToSys(FileName))); 22 | {$endif} 23 | end; 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /readme.txt: -------------------------------------------------------------------------------- 1 | This directory contains a copy (sometimes modified) of r823 jcf2 svn tree: https://jedicodeformat.svn.sourceforge.net/svnroot/jedicodeformat/trunk/CodeFormat/Jcf2 2 | 3 | Only command line utility works currently. -------------------------------------------------------------------------------- /test.pas: -------------------------------------------------------------------------------- 1 | program test; 2 | 3 | (* JCF CLI test file *) 4 | 5 | uses CRT; 6 | 7 | procedure myProcedure; 8 | var s: String; 9 | begin 10 | s := 'this is a string'; 11 | writeln(s); 12 | end; 13 | 14 | function myFunction(aParam: string): boolean; 15 | var i: integer; 16 | begin 17 | for i := 1 to 10 do 18 | if i < 10 then write(i, ',') 19 | else writeln(i); 20 | 21 | i := 1; 22 | repeat 23 | case i of 24 | 1..9: 25 | for i := 1 to i do write(i, ','); 26 | 10: begin 27 | writeln; 28 | writeln; 29 | end; 30 | else 31 | myProcedure; 32 | end; 33 | until i >= 10; 34 | 35 | result := true; 36 | end; 37 | 38 | //# main program 39 | var 40 | c, r: Integer; 41 | s: String; 42 | a: Array of Integer; 43 | 44 | BEGIN 45 | //! clear first 46 | ClrScr; 47 | 48 | SetLength(a, 10); 49 | FOR c := 0 TO High(a) DO 50 | a[c] := c; 51 | FOR c := 0 TO High(a) DO 52 | IF i < High(a) THEN write(a[c], ',') 53 | ELSE writeln; 54 | 55 | c := ScreenWidth; //* screen size 56 | r := ScreenHeight; 57 | s := 'Screen size: '; 58 | writeln(s, c, '×', r); 59 | 60 | write('Enter your name: '); //? input 61 | readln(s); 62 | writeln('Hello, ', s, '!'); //+ forgotten 63 | 64 | //-readln; // unnecessary 65 | // TODO: to-do next 66 | END. --------------------------------------------------------------------------------