├── src ├── .gitkeep ├── zz_lisp_ide.prog.abap ├── package.devc.xml ├── yy_lib_turtle.prog.xml ├── yy_lib_registry.prog.xml ├── yy_lisp_turtle.prog.xml ├── zz_registry_test.prog.xml ├── zz_registry_browser.prog.xml ├── zcl_lisp_area.shma.xml ├── yy_lib_lisp.prog.xml ├── yy_lisp_aunit.prog.xml ├── yy_lisp_ide.prog.xml ├── yjn_script_sexpr_view.prog.xml ├── zcl_lisp_shm_root.clas.xml ├── zcl_lisp_shm_root.clas.abap ├── zz_registry_test.prog.abap ├── yjn_script_sexpr_view.prog.abap ├── yy_lisp_turtle.prog.abap ├── zz_lisp_ide.prog.xml ├── zcl_lisp_area.clas.xml ├── yy_lib_registry.prog.abap ├── zz_registry_browser.prog.abap ├── yy_lib_turtle.prog.abap └── zcl_lisp_area.clas.abap ├── _config.yml ├── img ├── sexpr_new.PNG ├── AUnit_Tests.png ├── new_editor.png ├── sample_sexp.png ├── zz_lisp_uml.png ├── default_editor.png ├── lisplogo_256.png ├── popular_blogs.png ├── abap_lisp_trace.png ├── sample_sexp_new.PNG ├── SExpressionViewer.png ├── abap_lisp_workbench.png ├── lisplogo_fancy_128.png └── abap_scheme_workbench.png ├── .travis.yml ├── .abapgit.xml ├── abaplint.json ├── LICENSE ├── .github └── workflows │ └── abaplint.yml ├── editor ├── lisp_user.xml ├── README.md └── lisp_spec.xml └── README.md /src/.gitkeep: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /_config.yml: -------------------------------------------------------------------------------- 1 | theme: jekyll-theme-cayman -------------------------------------------------------------------------------- /img/sexpr_new.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/sexpr_new.PNG -------------------------------------------------------------------------------- /img/AUnit_Tests.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/AUnit_Tests.png -------------------------------------------------------------------------------- /img/new_editor.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/new_editor.png -------------------------------------------------------------------------------- /img/sample_sexp.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/sample_sexp.png -------------------------------------------------------------------------------- /img/zz_lisp_uml.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/zz_lisp_uml.png -------------------------------------------------------------------------------- /img/default_editor.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/default_editor.png -------------------------------------------------------------------------------- /img/lisplogo_256.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/lisplogo_256.png -------------------------------------------------------------------------------- /img/popular_blogs.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/popular_blogs.png -------------------------------------------------------------------------------- /img/abap_lisp_trace.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/abap_lisp_trace.png -------------------------------------------------------------------------------- /img/sample_sexp_new.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/sample_sexp_new.PNG -------------------------------------------------------------------------------- /img/SExpressionViewer.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/SExpressionViewer.png -------------------------------------------------------------------------------- /img/abap_lisp_workbench.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/abap_lisp_workbench.png -------------------------------------------------------------------------------- /img/lisplogo_fancy_128.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/lisplogo_fancy_128.png -------------------------------------------------------------------------------- /img/abap_scheme_workbench.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nomssi/abap_scheme/HEAD/img/abap_scheme_workbench.png -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: node_js 2 | node_js: 3 | - "10" 4 | notifications: 5 | email: false 6 | before_script: 7 | - npm install -g abaplint 8 | script: 9 | - abaplint "src/**/*.*" 10 | branches: 11 | only: 12 | - Netweaver-7.52 13 | - master 14 | -------------------------------------------------------------------------------- /src/zz_lisp_ide.prog.abap: -------------------------------------------------------------------------------- 1 | REPORT zz_lisp_ide. 2 | 3 | INCLUDE yy_lib_lisp. 4 | 5 | INCLUDE yy_lisp_turtle. 6 | INCLUDE yy_lisp_aunit. 7 | INCLUDE yy_lisp_ide. 8 | 9 | INITIALIZATION. 10 | lcl_ide=>init( ). 11 | 12 | START-OF-SELECTION. 13 | lcl_ide=>main( ). 14 | -------------------------------------------------------------------------------- /src/package.devc.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | ABAP Scheme 7 | CA 8 | HLB0009110 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /src/yy_lib_turtle.prog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | YY_LIB_TURTLE 7 | I 8 | * 9 | K 10 | E 11 | X 12 | 13 | 14 | 15 | R 16 | Include YY_LIB_TURTLE 17 | 21 18 | 19 | 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /src/yy_lib_registry.prog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | YY_LIB_REGISTRY 7 | I 8 | * 9 | K 10 | E 11 | X 12 | 13 | 14 | 15 | R 16 | Include YY_LIB_REGISTRY 17 | 23 18 | 19 | 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /src/yy_lisp_turtle.prog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | YY_LISP_TURTLE 7 | I 8 | * 9 | K 10 | E 11 | X 12 | 13 | 14 | 15 | R 16 | Include YY_LISP_TURTLE 17 | 22 18 | 19 | 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /src/zz_registry_test.prog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | ZZ_REGISTRY_TEST 7 | 1 8 | * 9 | K 10 | E 11 | X 12 | X 13 | 14 | 15 | 16 | R 17 | Program ZZ_REGISTRY_TEST 18 | 24 19 | 20 | 21 | 22 | 23 | 24 | -------------------------------------------------------------------------------- /.abapgit.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | E 6 | /src/ 7 | PREFIX 8 | 9 | /.gitignore 10 | /LICENSE 11 | /README.md 12 | /package.json 13 | /.travis.yml 14 | /_config.yml 15 | /img/abap_lisp_workbench.png 16 | /src/.gitkeep 17 | /abaplint.json 18 | 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /src/zz_registry_browser.prog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | ZZ_REGISTRY_BROWSER 7 | 1 8 | * 9 | K 10 | E 11 | X 12 | X 13 | 14 | 15 | 16 | R 17 | Report ZZ_REGISTRY_BROWSER 18 | 26 19 | 20 | 21 | 22 | 23 | 24 | -------------------------------------------------------------------------------- /src/zcl_lisp_area.shma.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | ZCL_LISP_AREA 7 | ABAP Lisp Workbench - Shared Area 8 | ZCL_LISP_SHM_ROOT 9 | X 10 | X 11 | ZCL_LISP_SHM_ROOT 12 | 109200001 13 | 159200000 14 | 1208200200 15 | 1107197102 16 | 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /src/yy_lib_lisp.prog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | YY_LIB_LISP 7 | I 8 | * 9 | K 10 | E 11 | X 12 | 13 | 14 | 15 | R 16 | ABAP Scheme 17 | 18 18 | 19 | 20 | 21 | 22 | D 23 | 24 | 25 | R 26 | 18 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | -------------------------------------------------------------------------------- /src/yy_lisp_aunit.prog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | YY_LISP_AUNIT 7 | I 8 | * 9 | K 10 | E 11 | X 12 | 13 | 14 | 15 | R 16 | ABAP Scheme ABAP Unit Test Suite 17 | 37 18 | 19 | 20 | 21 | 22 | D 23 | 24 | 25 | R 26 | 18 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | -------------------------------------------------------------------------------- /src/yy_lisp_ide.prog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | YY_LISP_IDE 7 | I 8 | * 9 | K 10 | E 11 | X 12 | 13 | 14 | 15 | R 16 | ABAP Scheme Workbench 17 | 21 18 | 19 | 20 | 21 | 22 | D 23 | 24 | 25 | R 26 | Include YY_LISP_IDE 27 | 19 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /src/yjn_script_sexpr_view.prog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | YJN_SCRIPT_SEXPR_VIEW 7 | S 8 | S 9 | X 10 | X 11 | D$S 12 | X 13 | 14 | 15 | 16 | R 17 | 23 18 | 19 | 20 | 21 | 22 | D 23 | 24 | 25 | R 26 | S-Expression Viewer 27 | 19 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /src/zcl_lisp_shm_root.clas.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | ZCL_LISP_SHM_ROOT 7 | E 8 | ABAP Lisp: Shared Memory Puffer 9 | 1 10 | X 11 | X 12 | X 13 | K 14 | X 15 | 16 | 17 | 18 | LOAD 19 | E 20 | Save Information for Personalization 21 | 22 | 23 | SAVE 24 | E 25 | Retrieve Information for Personalization 26 | 27 | 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /abaplint.json: -------------------------------------------------------------------------------- 1 | { 2 | "global": { 3 | "files": "/src/**/*.*", 4 | "skipGeneratedGatewayClasses": true, 5 | "skipGeneratedPersistentClasses": true, 6 | "skipGeneratedFunctionGroups": true 7 | }, 8 | "dependencies": [ 9 | { 10 | "url": "https://github.com/abaplint/deps", 11 | "folder": "/deps", 12 | "files": "/src/**/*.*" 13 | } 14 | ], 15 | "syntax": { 16 | "version": "v740sp08", 17 | "errorNamespace": "^(Z|Y)", 18 | "globalConstants": [], 19 | "globalMacros": [] 20 | }, 21 | "rules": { 22 | "line_length": false, 23 | "contains_tab": false, 24 | "functional_writing": false, 25 | "max_one_statement": true, 26 | "parser_error": false, 27 | "space_before_colon": true, 28 | "colon_missing_space": true, 29 | "exit_or_check": false, 30 | "obsolete_statement": false, 31 | "start_at_tab": false, 32 | "whitespace_end": true, 33 | "exporting": true, 34 | "empty_statement": true, 35 | "sequential_blank": { 36 | "lines":4 37 | }, 38 | "definitions_top": false 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Jacques Nomssi 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 | -------------------------------------------------------------------------------- /.github/workflows/abaplint.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: CI 4 | 5 | # Controls when the action will run. 6 | on: 7 | # Triggers the workflow on push or pull request events but only for the master branch 8 | push: 9 | branches: [ master ] 10 | pull_request: 11 | branches: [ master ] 12 | 13 | # Allows you to run this workflow manually from the Actions tab 14 | workflow_dispatch: 15 | 16 | # A workflow run is made up of one or more jobs that can run sequentially or in parallel 17 | jobs: 18 | # This workflow contains a single job called "abaplint" 19 | build: 20 | # The type of runner that the job will run on 21 | runs-on: ubuntu-latest 22 | 23 | # Steps represent a sequence of tasks that will be executed as part of the job 24 | steps: 25 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 26 | - uses: actions/checkout@v2 27 | 28 | # Runs a command using the runners shell 29 | - name: abaplint 30 | uses: abaplint/actions-abaplint@main 31 | env: 32 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 33 | -------------------------------------------------------------------------------- /editor/lisp_user.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Jacques Nomssi 6 | LangUser 7 | LISP 8 | User specific settings for Scheme 9 | 10 | 11 | 12 | cond Conditionals 13 | (cond ((<test1>) <expression11> ... )\n ((<test2>) <expression21> ... )\n (else <expressionN1> ... ) 14 | 15 | 16 | ;;;----- 17 | ;;;------------------------------------------------------------------- 18 | 19 | 20 | (define ...) 21 | (define \n%SurroundedText%\n ) 22 | 23 | 24 | (let ...) binding 25 | (let ((<variable1> <init1>)\n ( <variableN> <initN>) )\n <body>) 26 | 27 | 28 | ;-------... 29 | 30 | 31 | (if ...) Conditional(if <test> \n <consequent>\n <alternate> )procedure(lambda (<formals>)\n (<body>))(do ...) Iteration(do (<variable1> <init1> <step1>)\n ... )\n (<test> <expression> ... )\n <command> ... )(begin ...) sequencing(begin ... ) 32 | 33 | -------------------------------------------------------------------------------- /src/zcl_lisp_shm_root.clas.abap: -------------------------------------------------------------------------------- 1 | class ZCL_LISP_SHM_ROOT definition 2 | public 3 | final 4 | create public 5 | shared memory enabled . 6 | 7 | public section. 8 | 9 | interfaces IF_SHM_BUILD_INSTANCE . 10 | 11 | types: 12 | BEGIN OF ts_settings, 13 | stack TYPE string_table, 14 | new_editor TYPE flag, 15 | END OF ts_settings . 16 | types: 17 | BEGIN OF ts_param. 18 | INCLUDE TYPE ts_settings as settings. 19 | TYPES: uname TYPE syuname, 20 | datum TYPE aedat, 21 | uzeit TYPE uzeit, 22 | END OF ts_param . 23 | 24 | methods LOAD 25 | importing 26 | !IV_UNAME type SYUNAME default SY-UNAME 27 | returning 28 | value(RS_SETTINGS) type TS_SETTINGS . 29 | methods SAVE 30 | importing 31 | !IV_UNAME type SYUNAME default SY-UNAME 32 | !IS_SETTINGS type TS_SETTINGS . 33 | PROTECTED SECTION. 34 | PRIVATE SECTION. 35 | DATA ms_param TYPE ts_param. 36 | ENDCLASS. 37 | 38 | 39 | 40 | CLASS ZCL_LISP_SHM_ROOT IMPLEMENTATION. 41 | 42 | 43 | METHOD if_shm_build_instance~build. 44 | DATA params TYPE REF TO zcl_lisp_shm_root. 45 | DATA handle TYPE REF TO zcl_lisp_area. 46 | 47 | handle = zcl_lisp_area=>attach_for_write( ). 48 | CREATE OBJECT params AREA HANDLE handle. 49 | handle->set_root( params ). 50 | * Initial values are saved 51 | handle->detach_commit( ). 52 | 53 | ENDMETHOD. 54 | 55 | 56 | METHOD LOAD. 57 | rs_settings = ms_param-settings. 58 | ENDMETHOD. 59 | 60 | 61 | METHOD SAVE. 62 | ms_param = VALUE #( settings = is_settings 63 | uname = iv_uname 64 | datum = sy-datum 65 | uzeit = sy-uzeit ). 66 | ENDMETHOD. 67 | ENDCLASS. 68 | -------------------------------------------------------------------------------- /src/zz_registry_test.prog.abap: -------------------------------------------------------------------------------- 1 | *&---------------------------------------------------------------------* 2 | *& Report ZZ_REGISTRY_TEST 3 | *&---------------------------------------------------------------------* 4 | *& Author: Martin Ceronio (2015), http://ceronio.net 5 | *& Released under MIT License: http://opensource.org/licenses/MIT 6 | *& All modifications by JNN 7 | *&---------------------------------------------------------------------* 8 | REPORT zz_registry_test. 9 | * Make the registry API available to our program 10 | 11 | INCLUDE yy_lib_registry. 12 | 13 | DATA reg_entry TYPE REF TO lcl_registry_entry. 14 | DATA lv_customer TYPE kunnr. 15 | DATA lv_run_date TYPE d. 16 | DATA lv_timestamp TYPE timestamp. 17 | 18 | START-OF-SELECTION. 19 | * Get the root entry of the registry 20 | DATA(reg_root) = lcl_registry_entry=>get_root( ). 21 | 22 | * If we want to ensure, on startup, that a certain entry exists, we 23 | * could do the following (e.g. in LOAD-OF-PROGRAM): 24 | reg_root->create_by_path( 'Sales/Enhancements/Process_XYZ' ). 25 | 26 | * Retrieval of a specific entry. If we did not have the above line, 27 | * we would have to check that the result of each call to GET_SUBENTRY( ) 28 | * to ensure it is bound. 29 | reg_entry = reg_root->get_subentry( 'Sales' )->get_subentry( 'Enhancements' )->get_subentry( 'Process_XYZ' ). 30 | 31 | * Getting a specific value from the entry: 32 | lv_customer = reg_entry->get_value( 'Process_XYZ' ). 33 | "lv_customer = reg_entry->get_value( 'Process_XYZCustomer' ). 34 | 35 | * Writing values to the entry: 36 | lv_run_date = sy-datum. 37 | reg_entry->set_value( key = 'LastRunDate' value = lv_run_date ). 38 | GET TIME STAMP FIELD lv_timestamp. 39 | reg_entry->set_value( key = 'LastRunDateTime' value = lv_timestamp ). 40 | 41 | * Saving the entry 42 | reg_entry->save( ). 43 | -------------------------------------------------------------------------------- /editor/README.md: -------------------------------------------------------------------------------- 1 | # ABAP Editor Configuration 2 | 3 | ## Default ABAP Scheme Workbench Editor 4 | ![Default Editor](/img/default_editor.png) 5 | 6 | ## How To Enable The New ABAP Editor 7 | The SAP GUI ABAP Editor for LISP enables 8 | * syntax highlighting 9 | * code completion 10 | 11 | ![Default Editor](/img/new_editor.png) 12 | 13 | ## SAP GUI Configuration Folder 14 | 15 | The SAP GUI configuration files are located in the roaming user application directory. They can be reached using the environment variable %APPDATA%. 16 | 17 | cd %APPDATA%\SAP\SAP GUI\ABAP Editor 18 | Windows 10 => [ C:\Users\\AppData\Roaming\SAP\SAP GUI\ABAP Editor ] 19 | 20 | ## Configuration Steps 21 | 1. You must manually copy two configuration files provided here in your local SAP GUI configuration folder for the ABAP Editor 22 | 23 | * lisp_spec.xml 24 | * lisp_user.xml 25 | 26 | 2. Change in the first lines of ABAP Include YY_LISP_IDE 27 | 28 | c_new_abap_editor TYPE flag VALUE abap_true, 29 | c_source_type TYPE string VALUE 'LISP'. 30 | 31 | 3. Restart the workbench. 32 | 33 | ## Configuration Files 34 | 35 | To create your own theme files 36 | 37 | * lisp_spec.xml 38 | * lisp_user.xml 39 | 40 | read 41 | 42 | * https://wiki.scn.sap.com/wiki/display/NWTech/SAP+GUI+Logon+Configuration 43 | * https://github.com/lucattelli/ab4-themes 44 | * https://github.com/alexey-arseniev/ab4-code-templates 45 | * https://blogs.sap.com/2017/08/01/old-new-abap-editor/ 46 | 47 | The comments in the blog post 48 | 49 | * https://blogs.sap.com/2015/06/24/a-lisp-interpreter-in-abap/ 50 | 51 | give useful hints: 52 | 53 | In lisp_spec.xml, 54 | 55 | add 56 | 57 | 58 | … 59 | 60 | 61 | 62 | … 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /src/yjn_script_sexpr_view.prog.abap: -------------------------------------------------------------------------------- 1 | * 2 | REPORT rstpda_script_template. 3 | 4 | * 5 | *RSTPDA_SCRIPT_TEMPLATE 6 | *LCL_DEBUGGER_SCRIPT 7 | *Debugger Skript: Default Template 8 | *X 9 | 10 | * 11 | 12 | * 13 | 14 | * 15 | 16 | * 17 | *---------------------------------------------------------------------* 18 | * CLASS lcl_debugger_script DEFINITION 19 | *---------------------------------------------------------------------* 20 | * 21 | *---------------------------------------------------------------------* 22 | CLASS lcl_debugger_script DEFINITION INHERITING FROM cl_tpda_script_class_super . 23 | 24 | PUBLIC SECTION. 25 | METHODS: prologue REDEFINITION, 26 | init REDEFINITION, 27 | script REDEFINITION, 28 | end REDEFINITION. 29 | 30 | ENDCLASS. "lcl_debugger_script DEFINITION 31 | *---------------------------------------------------------------------* 32 | * CLASS lcl_debugger_script IMPLEMENTATION 33 | *---------------------------------------------------------------------* 34 | * 35 | *---------------------------------------------------------------------* 36 | CLASS lcl_debugger_script IMPLEMENTATION. 37 | METHOD prologue. 38 | *** generate abap_source (source handler for ABAP) 39 | super->prologue( ). 40 | ENDMETHOD. "prolog 41 | 42 | METHOD init. 43 | *** insert your initialization code here 44 | ENDMETHOD. "init 45 | METHOD script. 46 | 47 | *** insert your script code here 48 | me->break( ). 49 | 50 | ENDMETHOD. "script 51 | METHOD end. 52 | *** insert your code which shall be executed at the end of the scripting (before trace is saved) 53 | *** here 54 | 55 | ENDMETHOD. "end 56 | ENDCLASS. "lcl_debugger_script IMPLEMENTATION 57 | * 58 | 59 | * 60 | -------------------------------------------------------------------------------- /src/yy_lisp_turtle.prog.abap: -------------------------------------------------------------------------------- 1 | *&---------------------------------------------------------------------* 2 | *& Include YY_LISP_TURTLE 3 | *&---------------------------------------------------------------------* 4 | * Ported from https://github.com/FreHu/abap-turtle-graphics 5 | 6 | CLASS lcl_turtle_examples DEFINITION. 7 | PUBLIC SECTION. 8 | CLASS-METHODS polygon_flower 9 | IMPORTING polygons TYPE tv_int 10 | polygon_sides TYPE tv_int 11 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 12 | 13 | CLASS-METHODS filled_square 14 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 15 | 16 | CLASS-METHODS polygon_using_lines 17 | IMPORTING num_sides TYPE tv_int 18 | side_length TYPE tv_int 19 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 20 | 21 | PRIVATE SECTION. 22 | CLASS-METHODS demo IMPORTING title TYPE string OPTIONAL 23 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 24 | ENDCLASS. 25 | 26 | CLASS lcl_turtle_examples IMPLEMENTATION. 27 | 28 | METHOD demo. 29 | turtle = lcl_turtle=>new( height = 800 width = 800 title = title ). 30 | turtle->goto( x = 200 y = 200 ). 31 | 32 | turtle->set_pen( VALUE #( 33 | fill_color = `#FF0000` 34 | stroke_color = `#FF00FF` 35 | stroke_width = 2 ) ). 36 | ENDMETHOD. 37 | 38 | METHOD filled_square. 39 | turtle = demo( )->filled_square( side_length = 100 40 | start = VALUE lcl_turtle=>t_point( x = 100 y = 100 ) ). 41 | ENDMETHOD. 42 | 43 | METHOD polygon_flower. 44 | turtle = demo( title = |Polygons:{ polygons } Sides: { polygon_sides }| 45 | )->polygon_flower( number_of_polygons = polygons 46 | polygon_sides = polygon_sides 47 | side_length = 50 ). 48 | ENDMETHOD. 49 | 50 | METHOD polygon_using_lines. 51 | turtle = demo( )->regular_polygon( num_sides = num_sides 52 | side_length = side_length ). 53 | ENDMETHOD. 54 | ENDCLASS. 55 | 56 | CLASS lcl_turtle_lsystem_examples DEFINITION. 57 | PUBLIC SECTION. 58 | CLASS-METHODS koch_curve. 59 | CLASS-METHODS pattern. 60 | CLASS-METHODS plant. 61 | CLASS-METHODS plant_2. 62 | PRIVATE SECTION. 63 | CLASS-METHODS execute IMPORTING title TYPE string OPTIONAL 64 | x TYPE tv_int DEFAULT 200 65 | y TYPE tv_int DEFAULT 200 66 | angle TYPE tv_real OPTIONAL 67 | parameters TYPE lcl_turtle_lsystem=>params. 68 | ENDCLASS. 69 | 70 | CLASS lcl_turtle_lsystem_examples IMPLEMENTATION. 71 | 72 | METHOD execute. 73 | DATA(turtle) = lcl_turtle=>new( height = 800 width = 600 title = title ). 74 | turtle->goto( x = x 75 | y = y ). 76 | turtle->set_angle( angle ). 77 | 78 | DATA(lsystem) = lcl_turtle_lsystem=>new( turtle = turtle 79 | parameters = parameters ). 80 | lsystem->execute( ). 81 | lsystem->show( ). 82 | ENDMETHOD. 83 | 84 | METHOD koch_curve. 85 | execute( title = |Koch curve| 86 | parameters = lcl_turtle_lsystem=>koch_curve_params( ) ). 87 | ENDMETHOD. 88 | 89 | 90 | METHOD pattern. 91 | execute( parameters = lcl_turtle_lsystem=>pattern_params( ) ). 92 | ENDMETHOD. 93 | 94 | METHOD plant. 95 | execute( x = 300 96 | y = 600 97 | angle = -90 98 | parameters = lcl_turtle_lsystem=>plant_params( ) ). 99 | ENDMETHOD. 100 | 101 | METHOD plant_2. 102 | execute( x = 300 103 | y = 600 104 | angle = -90 105 | parameters = lcl_turtle_lsystem=>plant_2_params( ) ). 106 | ENDMETHOD. 107 | 108 | ENDCLASS. 109 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ABAP Scheme 2 | [![Language: ABAP](https://img.shields.io/badge/Language-ABAP-blue.svg?style=flat)](https://www.sap.com/developer/topics/abap-platform.html) 3 | [![License: MIT](https://img.shields.io/github/license/mashape/apistatus.svg?style=flat)](https://opensource.org/licenses/MIT) 4 | 5 | - is an interpreter for Scheme, a Lisp dialect with exceptionally clear and concise semantics and a focus on functional programming 6 | - provides a SAP GUI based workbench for Scheme 7 | - is written in, and can be called from ABAP 8 | 9 | ## Getting Started 10 | The code can be cloned with [ABAP GIT](http://docs.abapgit.org/). 11 | 12 | - The main version is developed on Netweaver 7.5 and should work on ABAP Netweaver 7.4. 13 | - Milestones are downported to other branches (7.02). 14 | - The legacy code on [SCN Code Gallery](https://wiki.scn.sap.com/wiki/display/Snippets/Lisp+Interpreter+in+ABAP) should work on older releases. 15 | 16 | To check your installation, execute this guess my number game... 17 | 18 | ```Scheme 19 | (begin (display "Please enter a number between 1 - 100: ") 20 | (do ((quit #f) 21 | (guess 0) 22 | (answer (+ 1 (random 100))) ) 23 | (quit) 24 | (begin (set! guess (read)) (display guess) ) 25 | (cond ((and (number? guess) (< guess answer)) (display "\nToo low. Please guess again: ") ) 26 | ((and (number? guess) (> guess answer)) (display "\nToo high. Please guess again: ") ) 27 | (else (set! quit #t) (if (number? guess) (display "\nCorrect!") 28 | (display "\nGood bye...") ) ) ) ) ) 29 | ``` 30 | 31 | Scheme syntax is based upon nested parenthesization. The [wiki pages](https://github.com/nomssi/abap_scheme/wiki) are a good place to start. 32 | 33 | * I suggest you check the [syntax](https://github.com/nomssi/abap_scheme/wiki/Learn-Try-Scheme) and understand [Lists](https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Lists.html#Lists). 34 | * For questions/comments/bugs/feature requests/wishes please create an [issue](https://github.com/nomssi/abap_scheme/issues) 35 | * How to [enable the new editor](/editor) 36 | 37 | ## Why Scheme? 38 | - [Scheme](https://en.wikipedia.org/wiki/Scheme_%28programming_language%29) is one of the main Lisp dialects, alongside *Common Lisp* and *Clojure*. Conrad Barski's [Land of Lisp](http://landoflisp.com), Martin Ceronio's [LISP interpreter in ABAP](https://blogs.sap.com/2015/06/24/a-lisp-interpreter-in-abap/) and [Peter Norvig](http://norvig.com/lispy2.html) inspired me to learn Lisp. It is common to [Make your own Lisp](https://github.com/kanaka/mal/blob/master/process/guide.md) to really understand Lisp's core concepts. 39 | 40 | [![LISP Inside](https://github.com/nomssi/abap_scheme/blob/master/img/lisplogo_256.png)](http://lisperati.com/logo.html) 41 | 42 | - Scheme's uses *symbolic expressions* (S-exps) to represent code *and* data. Expressions are then [evaluated](https://docs.racket-lang.org/reference/eval-model.html). Those concepts cannot be expressed in ABAP, except by first implementing a Lisp interpreter in ABAP ([Greenspun 10th rule](http://www.paulgraham.com/quotes.html) ). 43 | 44 | - My initial plan was to write a Lisp workbench for [Martin's Lisp interpreter](https://github.com/mydoghasworms/abap-lisp). I changed the target language after reading the *Revised 7 Report on the Algorithmic Language Scheme* aka [R7RS small](http://www.r7rs.org/) that offers a lot of examples to verify the interpreter. With this I can aim at compatibility with open source Scheme code. 45 | 46 | - In constrast to ABAP, Scheme has a very small number of rules for forming expressions that can be composed without restrictions. Scheme is lexically scoped and requires proper tail call optimization. Scheme is apt at [symbolic processing](https://github.com/nomssi/abap_scheme/wiki/Learn-Try-Symbolic-Derivation). 47 | 48 | ### Features 49 | - ABAP Scheme supports a subset of [R7RS](http://www.r7rs.org/) with some [Racket](https://docs.racket-lang.org/) extensions. Check the current [list of features](https://github.com/nomssi/abap_scheme/wiki/Features) 50 | - This documentation is the source of many of the 500+ tests implemented in the ABAP unit test suite. 51 | - Access to ABAP global fields and function modules 52 | - a programming environment to make it fun to use, featuring the editor and console views, a trace view, a graphical S-Expression viewer 53 | 54 | S-expression for (* 2 (+ 3 4)) | workbench view 55 | --- | --- 56 | ![s-exp](https://upload.wikimedia.org/wikipedia/commons/thumb/e/e3/Corrected_S-expression_tree_2.png/220px-Corrected_S-expression_tree_2.png) | ![workbench view](https://github.com/nomssi/abap_scheme/blob/master/img/sexpr_new.PNG) 57 | 58 | - R7RS alignment makes it easier to run open source Scheme code. This is however limited, as *first class continuations* (call cc) and *hygienic macros* (define-syntax) are missing 59 | 60 | ### Architecture 61 | 62 | - Report ZZ_LISP_IDE - Main report for the workbench 63 | - Include YY_LIB_LISP - Complete ABAP LISP library 64 | - Include YY_LISP_AUNIT - a large _ABAP Unit_ regression test suite 65 | - Include YY_LISP_IDE - Editor/Tools 66 | 67 | ### ABAP Integration 68 | #### Interpreter 69 | Class `lcl_lisp_interpreter` evaluates your Scheme code in a string `code`, using either method `eval_repl( code )` which throws an exception on errors, or method `eval_source( code )` catches exception: 70 | 71 | ```ABAP 72 | DATA(response) = NEW lcl_lisp_interpreter( io_port = port 73 | ii_log = log )->eval_source( code ). 74 | ``` 75 | `port` is a buffered port that can allow input or output. `log` implements a simple logging interface with 2 methods, put( ) and get( ). 76 | #### Access to ABAP Fields 77 | For a [dynamic IF statement](https://blogs.sap.com/2016/02/29/dynamic-if-condition/) 78 | `( PLAAB = '02' ) and ( DELKZ = 'BB') and ( LIFNR > '' ) and ( PLUMI = '-')` 79 | we concatenate the following Scheme expression in a string variable `code` and evaluate. 80 | 81 | ```Scheme 82 | (let 83 | ; Define local fields 84 | ((PLAAB (ab-data "GS_MDPS-PLAAB" )) 85 | (DELKZ (ab-data "GS_MDPS-DELKZ" )) 86 | (LIFNR (ab-data "GS_MDPS-LIFNR" )) 87 | (PLUMI (ab-data "GS_MDPS-PLUMI" ))) 88 | (and (= PLAAB '02') (= DELKZ 'BB') (> LIFNR '') (= PLUMI '-')) ) 89 | ``` 90 | 91 | The result on the expression either `#t` or `#f`. 92 | 93 | #### Function Module Call 94 | 95 | ```Scheme 96 | (let (( profiles 97 | (let ( (f3 (ab-function "BAPI_USER_GET_DETAIL")) ) 98 | ( begin (ab-set f3 "USERNAME" (ab-get ab-sy "UNAME") ) ; param USERNAME = sy-uname 99 | (f3) ; function module call 100 | (ab-get f3 "PROFILES") ) ) ; return table PROFILES 101 | ) ) 102 | (let ((profile (ab-get profiles 1)) ) ; read table PROFILES index 1 INTO profile 103 | (ab-get profile "BAPIPROF" ) ) ) ; read field profile-bapiprof 104 | ``` 105 | 106 | #### Optional: Console Interface 107 | 108 | ```ABAP 109 | INTERFACE lif_input_port. 110 | METHODS read IMPORTING iv_title TYPE string OPTIONAL 111 | RETURNING VALUE(rv_input) TYPE string. 112 | METHODS peek_char RETURNING VALUE(rv_char) TYPE char01. 113 | METHODS is_char_ready RETURNING VALUE(rv_flag) TYPE flag. 114 | METHODS read_char RETURNING VALUE(rv_char) TYPE char01. 115 | METHODS put IMPORTING iv_text TYPE string. 116 | ENDINTERFACE. 117 | 118 | INTERFACE lif_output_port. 119 | METHODS write IMPORTING element TYPE REF TO lcl_lisp. 120 | METHODS display IMPORTING element TYPE REF TO lcl_lisp 121 | RAISING lcx_lisp_exception. 122 | ENDINTERFACE. 123 | ``` 124 | 125 | ### Workbench 126 | ![abap_scheme](https://github.com/nomssi/abap_scheme/blob/master/img/abap_scheme_workbench.png) 127 | ![abap_trace](https://github.com/nomssi/abap_scheme/blob/master/img/abap_lisp_trace.png) 128 | ![abap_expression](https://github.com/nomssi/abap_scheme/blob/master/img/SExpressionViewer.png) 129 | 130 | 131 | Read the ABAP Scheme [announcement](https://blogs.sap.com/2018/02/01/announcing-the-abap-scheme-workbench/) blog 132 | -------------------------------------------------------------------------------- /editor/lisp_spec.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Jacques Nomssi 6 | LangSpec 7 | LISP 8 | Language specification for Scheme 9 | 10 | 11 | *.scm 12 | 1 13 | ()[]''""||{} 14 | 15 | (), 16 | 17 | 0-9a-Z_/<>!$%&*+-.:=?@^~ 18 | 19 | 20 | 21 | 22 | 23 | 24 | 2 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | ; 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 | 192 | 193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | 228 | 229 | 230 | 231 | 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | 240 | 241 | 242 | 243 | 244 | 245 | 246 | 247 | 248 | 249 | 250 | 251 | 252 | 253 | 254 | 255 | 256 | 257 | 258 | 259 | 260 | 261 | 262 | 263 | 264 | 265 | 266 | 267 | 268 | 269 | 270 | 271 | 272 | 273 | 274 | 275 | 276 | 277 | 278 | 279 | 280 | 281 | 282 | 283 | 284 | 285 | 286 | 287 | 288 | 289 | 290 | 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 | 299 | 300 | 301 | 302 | 303 | 304 | 305 | 306 | 307 | 308 | 309 | 310 | 311 | 312 | 313 | 314 | 315 | 316 | 317 | 318 | 319 | 320 | 321 | 322 | 323 | 324 | 325 | 326 | 327 | 328 | 329 | 330 | 331 | 332 | 333 | 334 | 335 | 336 | 337 | 338 | 339 | 340 | 341 | 342 | 343 | 344 | 345 | 346 | 347 | 348 | 349 | 350 | 351 | 352 | 353 | 354 | 355 | 356 | 357 | 358 | 359 | 360 | 361 | 362 | 363 | 364 | 365 | 366 | -------------------------------------------------------------------------------- /src/zz_lisp_ide.prog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | ZZ_LISP_IDE 7 | 1 8 | * 9 | K 10 | E 11 | X 12 | X 13 | 14 | 15 | 16 |
17 | ZZ_LISP_IDE 18 | 0100 19 | E 20 | ABAP LISP Workbench 21 | N 22 | 0100 23 | 027 24 | 120 25 |
26 | 27 | 28 | SCREEN 29 | SCREEN 30 | 31 | 32 | 33 | 34 | SCREEN 35 | SCREEN 36 | OKCODE 37 | G_OK_CODE 38 | ____________________ 39 | 020 40 | 020 41 | 001 42 | CHAR 43 | X 44 | 45 | 46 | 47 | 48 | PROCESS BEFORE OUTPUT. 49 | 50 | 51 | MODULE status_0100. 52 | 53 | 54 | 55 | PROCESS AFTER INPUT. 56 | 57 | 58 | MODULE cancel_0100 AT EXIT-COMMAND. 59 | 60 | 61 | MODULE user_command_0100. 62 | 63 | 64 | 65 | 66 | 67 | 68 | 000001 69 | 000005 70 | 000001 71 | 72 | 73 | 74 | STATUS_100 75 | D 76 | 000001 77 | 000001 78 | 0001 79 | ABAP LISP Status 80 | 81 | 82 | 83 | 84 | BACK 85 | 001 86 | E 87 | S 88 | Back 89 | 90 | 91 | CANCEL 92 | 001 93 | E 94 | S 95 | ICON_CANCEL 96 | @0W@ 97 | Cancel 98 | 99 | 100 | CLEAR 101 | 001 102 | S 103 | ICON_DELETE 104 | @11@ 105 | Refresh 106 | Refresh 107 | Delete Source 108 | E 109 | 110 | 111 | EXECUTE 112 | 001 113 | S 114 | ICON_SYSTEM_PLAY 115 | @I6@ 116 | Evaluate 117 | Evaluate 118 | Run 119 | V 120 | 121 | 122 | EXIT 123 | 001 124 | E 125 | S 126 | Exit 127 | X 128 | 129 | 130 | GRAPH 131 | 001 132 | S 133 | ICON_TREE 134 | @3M@ 135 | S-Expression 136 | S-Expression 137 | View nested list data 138 | I 139 | 140 | 141 | GRPHCFG 142 | 001 143 | S 144 | Graph Config... 145 | G 146 | 147 | 148 | HELP 149 | 001 150 | S 151 | ICON_INFORMATION 152 | @0S@ 153 | Help 154 | Help 155 | Online manual 156 | H 157 | 158 | 159 | NEXT 160 | 001 161 | S 162 | ICON_ARROW_RIGHT 163 | @9T@ 164 | Next 165 | Next 166 | Next expression 167 | 168 | 169 | PREV 170 | 001 171 | S 172 | ICON_ARROW_LEFT 173 | @9S@ 174 | Previous 175 | Previous 176 | Previous expression 177 | 178 | 179 | TRACE 180 | 001 181 | S 182 | Eval with Trace 183 | A 184 | 185 | 186 | VALIDATE 187 | 001 188 | S 189 | Eval with Trace 190 | 191 | 192 | VALIDATE 193 | 002 194 | S 195 | Check Syntax 196 | Help on.. 197 | C 198 | 199 | 200 | WIKI 201 | 001 202 | S 203 | ICON_INFORMATION 204 | @0S@ 205 | Help 206 | Help on.. 207 | Online manual 208 | 209 | 210 | 211 | 212 | 000001 213 | 01 214 | F 215 | EXECUTE 216 | 001 217 | 218 | 219 | 000001 220 | 02 221 | F 222 | TRACE 223 | 001 224 | 225 | 226 | 000001 227 | 03 228 | F 229 | VALIDATE 230 | 002 231 | 232 | 233 | 000001 234 | 04 235 | S 236 | 237 | 238 | 000001 239 | 05 240 | F 241 | GRAPH 242 | 001 243 | 244 | 245 | 000001 246 | 06 247 | F 248 | GRPHCFG 249 | 001 250 | 251 | 252 | 000001 253 | 07 254 | S 255 | 256 | 257 | 000001 258 | 08 259 | F 260 | CLEAR 261 | 001 262 | 263 | 264 | 000001 265 | 09 266 | F 267 | EXIT 268 | 001 269 | 270 | 271 | 272 | 273 | 000001 274 | S 275 | User Interface 276 | U 277 | Standard Supplement 278 | 279 | 280 | 281 | 282 | 000001 283 | 01 284 | 000001 285 | 286 | 287 | 288 | 289 | 000001 290 | 0001 291 | 01 292 | 08 293 | 294 | 295 | 000001 296 | 0001 297 | 02 298 | 02 299 | 300 | 301 | 000001 302 | 0001 303 | 03 304 | 23 305 | 306 | 307 | 000001 308 | 0001 309 | 04 310 | 24 311 | 312 | 313 | 000001 314 | 0001 315 | 05 316 | 14 317 | 318 | 319 | 000001 320 | 0001 321 | 06 322 | S 323 | 324 | 325 | 000001 326 | 0001 327 | 07 328 | 13 329 | 330 | 331 | 332 | 333 | 000001 334 | 01 335 | HELP 336 | 001 337 | 338 | 339 | 000001 340 | 02 341 | GRAPH 342 | 001 343 | 344 | 345 | 000001 346 | 03 347 | BACK 348 | 001 349 | 350 | 351 | 000001 352 | 08 353 | EXECUTE 354 | 001 355 | 356 | 357 | 000001 358 | 12 359 | CANCEL 360 | 001 361 | 362 | 363 | 000001 364 | 13 365 | WIKI 366 | 001 367 | 368 | 369 | 000001 370 | 14 371 | CLEAR 372 | 001 373 | 374 | 375 | 000001 376 | 15 377 | EXIT 378 | 001 379 | 380 | 381 | 000001 382 | 23 383 | PREV 384 | 001 385 | 386 | 387 | 000001 388 | 24 389 | NEXT 390 | 001 391 | 392 | 393 | 394 | 395 | STATUS_100 396 | BACK 397 | 398 | 399 | STATUS_100 400 | CANCEL 401 | 402 | 403 | STATUS_100 404 | CLEAR 405 | 406 | 407 | STATUS_100 408 | EXECUTE 409 | 410 | 411 | STATUS_100 412 | EXIT 413 | 414 | 415 | STATUS_100 416 | GRAPH 417 | 418 | 419 | STATUS_100 420 | GRPHCFG 421 | 422 | 423 | STATUS_100 424 | HELP 425 | 426 | 427 | STATUS_100 428 | NEXT 429 | 430 | 431 | STATUS_100 432 | PREV 433 | 434 | 435 | STATUS_100 436 | TEST 437 | 438 | 439 | STATUS_100 440 | TRACE 441 | 442 | 443 | STATUS_100 444 | VALIDATE 445 | 446 | 447 | STATUS_100 448 | WIKI 449 | 450 | 451 | 452 | 453 | A 454 | 000001 455 | D 456 | ABAP LISP Status 457 | 458 | 459 | B 460 | 000001 461 | 0001 462 | D 463 | ABAP LISP Status 464 | 465 | 466 | P 467 | 000001 468 | D 469 | ABAP LISP Status 470 | 471 | 472 | 473 | 474 | TITLE_100 475 | ABAP LISP Workbench - & 476 | 477 | 478 | 479 | 480 | 481 | I 482 | C00 483 | Remember my settings 484 | 40 485 | 486 | 487 | I 488 | C10 489 | PlantUML Execution Mode 490 | 40 491 | 492 | 493 | I 494 | C11 495 | PlantUML web service 496 | 40 497 | 498 | 499 | I 500 | C12 501 | Save text file 502 | 24 503 | 504 | 505 | I 506 | C13 507 | Local PlantUML 508 | 24 509 | 510 | 511 | I 512 | C20 513 | PlantUML Settings 514 | 24 515 | 516 | 517 | I 518 | C21 519 | Scale 520 | 15 521 | 522 | 523 | I 524 | C25 525 | PlantUML Server 526 | 24 527 | 528 | 529 | I 530 | C26 531 | Local PlantUML path 532 | 24 533 | 534 | 535 | I 536 | C27 537 | Local PlantUML jar file 538 | 40 539 | 540 | 541 | I 542 | C28 543 | Local Java path 544 | 24 545 | 546 | 547 | I 548 | C32 549 | Display source 550 | 24 551 | 552 | 553 | R 554 | Program ZZ_LISP_IDE 555 | 19 556 | 557 | 558 | 559 | 560 | 561 | -------------------------------------------------------------------------------- /src/zcl_lisp_area.clas.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | ZCL_LISP_AREA 7 | E 8 | ABAP Lisp Workbench - Shared Area 9 | 45 10 | 1 11 | X 12 | X 13 | X 14 | S 15 | 16 | 17 | 18 | AREA_NAME 19 | E 20 | Name of an Area Class 21 | 22 | 23 | ATTACH_FOR_READ 24 | E 25 | Request a Read Lock 26 | 27 | 28 | ATTACH_FOR_UPDATE 29 | E 30 | Request a Change Lock 31 | 32 | 33 | ATTACH_FOR_WRITE 34 | E 35 | Request a Write Lock 36 | 37 | 38 | BUILD 39 | E 40 | Direct Call of Area Constructor 41 | 42 | 43 | CLASS_CONSTRUCTOR 44 | E 45 | CLASS_CONSTRUCTOR 46 | 47 | 48 | DETACH_AREA 49 | E 50 | Release all locks on all instances 51 | 52 | 53 | FREE_AREA 54 | E 55 | Delete all instances 56 | 57 | 58 | FREE_INSTANCE 59 | E 60 | Deletion of an Instance 61 | 62 | 63 | GET_GENERATOR_VERSION 64 | E 65 | Query Generator Version 66 | 67 | 68 | GET_INSTANCE_INFOS 69 | E 70 | Returns the names of all instances 71 | 72 | 73 | INVALIDATE_AREA 74 | E 75 | Active versions of all instances will be set to obsolete 76 | 77 | 78 | INVALIDATE_INSTANCE 79 | E 80 | Active version of one instance will be set to obsolete 81 | 82 | 83 | ROOT 84 | E 85 | SHM: Model of a Data Class 86 | 87 | 88 | SET_ROOT 89 | E 90 | Sets Root Objects 91 | 92 | 93 | _LIFE_CONTEXT 94 | E 95 | Lifetime of an Area (Constants in CL_SHM_AREA) 96 | 97 | 98 | _TRACE_ACTIVE 99 | E 100 | (Internal) Flag: Trace Active? 101 | 102 | 103 | _TRACE_SERVICE 104 | E 105 | (Internal) Reference to Trace Class 106 | 107 | 108 | _VERSION_ 109 | E 110 | (internal) 111 | 112 | 113 | 114 | 115 | ATTACH_FOR_READ 116 | CX_SHM_CHANGE_LOCK_ACTIVE 117 | E 118 | A Change Lock Is Already Active 119 | 120 | 121 | ATTACH_FOR_READ 122 | CX_SHM_EXCLUSIVE_LOCK_ACTIVE 123 | E 124 | Instance Already Locked 125 | 126 | 127 | ATTACH_FOR_READ 128 | CX_SHM_INCONSISTENT 129 | E 130 | Different Definitions Between Program and Area 131 | 132 | 133 | ATTACH_FOR_READ 134 | CX_SHM_NO_ACTIVE_VERSION 135 | E 136 | No active version exists for an attach 137 | 138 | 139 | ATTACH_FOR_READ 140 | CX_SHM_PARAMETER_ERROR 141 | E 142 | Incorrect parameter passed 143 | 144 | 145 | ATTACH_FOR_READ 146 | CX_SHM_READ_LOCK_ACTIVE 147 | E 148 | Request for a Second Read Lock 149 | 150 | 151 | ATTACH_FOR_READ 152 | HANDLE 153 | E 154 | SHM: Model of an Area Class 155 | 156 | 157 | ATTACH_FOR_READ 158 | INST_NAME 159 | E 160 | Name of a Shared Object Instance of an Area 161 | 162 | 163 | ATTACH_FOR_UPDATE 164 | ATTACH_MODE 165 | E 166 | Mode of ATTACH (Constants in CL_SHM_AREA) 167 | 168 | 169 | ATTACH_FOR_UPDATE 170 | CX_SHM_CHANGE_LOCK_ACTIVE 171 | E 172 | A write lock is already active 173 | 174 | 175 | ATTACH_FOR_UPDATE 176 | CX_SHM_EXCLUSIVE_LOCK_ACTIVE 177 | E 178 | Instance Already Locked 179 | 180 | 181 | ATTACH_FOR_UPDATE 182 | CX_SHM_INCONSISTENT 183 | E 184 | Different Definitions Between Program and Area 185 | 186 | 187 | ATTACH_FOR_UPDATE 188 | CX_SHM_NO_ACTIVE_VERSION 189 | E 190 | No active version exists for an attach 191 | 192 | 193 | ATTACH_FOR_UPDATE 194 | CX_SHM_PARAMETER_ERROR 195 | E 196 | Passed parameter has incorrect value 197 | 198 | 199 | ATTACH_FOR_UPDATE 200 | CX_SHM_PENDING_LOCK_REMOVED 201 | E 202 | Shared Objects: Waiting Lock Was Deleted 203 | 204 | 205 | ATTACH_FOR_UPDATE 206 | CX_SHM_VERSION_LIMIT_EXCEEDED 207 | E 208 | No Additional Versions Available 209 | 210 | 211 | ATTACH_FOR_UPDATE 212 | HANDLE 213 | E 214 | SHM: Model of an Area Class 215 | 216 | 217 | ATTACH_FOR_UPDATE 218 | INST_NAME 219 | E 220 | Name of a Shared Object Instance of an Area 221 | 222 | 223 | ATTACH_FOR_UPDATE 224 | WAIT_TIME 225 | E 226 | Maximum Wait Time (in Milliseconds) 227 | 228 | 229 | ATTACH_FOR_WRITE 230 | ATTACH_MODE 231 | E 232 | Mode of ATTACH (Constants in CL_SHM_AREA) 233 | 234 | 235 | ATTACH_FOR_WRITE 236 | CX_SHM_CHANGE_LOCK_ACTIVE 237 | E 238 | A write lock is already active 239 | 240 | 241 | ATTACH_FOR_WRITE 242 | CX_SHM_EXCLUSIVE_LOCK_ACTIVE 243 | E 244 | Instance Already Locked 245 | 246 | 247 | ATTACH_FOR_WRITE 248 | CX_SHM_PARAMETER_ERROR 249 | E 250 | Passed parameter has incorrect value 251 | 252 | 253 | ATTACH_FOR_WRITE 254 | CX_SHM_PENDING_LOCK_REMOVED 255 | E 256 | Shared Objects: Waiting Lock Was Deleted 257 | 258 | 259 | ATTACH_FOR_WRITE 260 | CX_SHM_VERSION_LIMIT_EXCEEDED 261 | E 262 | No Additional Versions Available 263 | 264 | 265 | ATTACH_FOR_WRITE 266 | HANDLE 267 | E 268 | SHM: Model of an Area Class 269 | 270 | 271 | ATTACH_FOR_WRITE 272 | INST_NAME 273 | E 274 | Name of a Shared Object Instance of an Area 275 | 276 | 277 | ATTACH_FOR_WRITE 278 | WAIT_TIME 279 | E 280 | Maximum Wait Time (in Milliseconds) 281 | 282 | 283 | BUILD 284 | CX_SHMA_INCONSISTENT 285 | E 286 | SHM Administration: Inconsistent Attribute Combination 287 | 288 | 289 | BUILD 290 | CX_SHMA_NOT_CONFIGURED 291 | E 292 | SHM Administration: Area Property Is Not Configured 293 | 294 | 295 | BUILD 296 | CX_SHM_BUILD_FAILED 297 | E 298 | Constructor Run Failed 299 | 300 | 301 | BUILD 302 | INST_NAME 303 | E 304 | Name of a Shared Object Instance of an Area 305 | 306 | 307 | DETACH_AREA 308 | RC 309 | E 310 | Detach Return Value (Constants in CL_SHM_AREA) 311 | 312 | 313 | FREE_AREA 314 | AFFECT_SERVER 315 | E 316 | Servers on which the area is deleted or invalidated 317 | 318 | 319 | FREE_AREA 320 | CX_SHM_PARAMETER_ERROR 321 | E 322 | Incorrect parameter passed 323 | 324 | 325 | FREE_AREA 326 | RC 327 | E 328 | Return Value (Constants in CL_SHM_AREA) 329 | 330 | 331 | FREE_AREA 332 | TERMINATE_CHANGER 333 | E 334 | Writing processes will be ended 335 | 336 | 337 | FREE_INSTANCE 338 | AFFECT_SERVER 339 | E 340 | Servers on which the area is deleted or invalidated 341 | 342 | 343 | FREE_INSTANCE 344 | CX_SHM_PARAMETER_ERROR 345 | E 346 | Incorrect parameter passed 347 | 348 | 349 | FREE_INSTANCE 350 | INST_NAME 351 | E 352 | Name of a Shared Object Instance of an Area 353 | 354 | 355 | FREE_INSTANCE 356 | RC 357 | E 358 | Return Value (Constants in CL_SHM_AREA) 359 | 360 | 361 | FREE_INSTANCE 362 | TERMINATE_CHANGER 363 | E 364 | Writing processes will be ended 365 | 366 | 367 | GET_INSTANCE_INFOS 368 | INFOS 369 | E 370 | Overview of all Instances of an SHM Area 371 | 372 | 373 | GET_INSTANCE_INFOS 374 | INST_NAME 375 | E 376 | Name of a Shared Object Instance in an Area 377 | 378 | 379 | INVALIDATE_AREA 380 | AFFECT_SERVER 381 | E 382 | Servers on which the area is deleted or invalidated 383 | 384 | 385 | INVALIDATE_AREA 386 | CX_SHM_PARAMETER_ERROR 387 | E 388 | Incorrect parameter passed 389 | 390 | 391 | INVALIDATE_AREA 392 | RC 393 | E 394 | Detach Return Value (Constants in CL_SHM_AREA) 395 | 396 | 397 | INVALIDATE_AREA 398 | TERMINATE_CHANGER 399 | E 400 | Active writing processes will be ended 401 | 402 | 403 | INVALIDATE_INSTANCE 404 | AFFECT_SERVER 405 | E 406 | Servers on which the area is deleted or invalidated 407 | 408 | 409 | INVALIDATE_INSTANCE 410 | CX_SHM_PARAMETER_ERROR 411 | E 412 | Incorrect parameter passed 413 | 414 | 415 | INVALIDATE_INSTANCE 416 | INST_NAME 417 | E 418 | Name of a Shared Object Instance of an Area 419 | 420 | 421 | INVALIDATE_INSTANCE 422 | RC 423 | E 424 | Detach Return Value (Constants in CL_SHM_AREA) 425 | 426 | 427 | INVALIDATE_INSTANCE 428 | TERMINATE_CHANGER 429 | E 430 | Active writing processes will be ended 431 | 432 | 433 | SET_ROOT 434 | CX_SHM_INITIAL_REFERENCE 435 | E 436 | Initial reference passed 437 | 438 | 439 | SET_ROOT 440 | CX_SHM_WRONG_HANDLE 441 | E 442 | Incorrect Handle 443 | 444 | 445 | SET_ROOT 446 | ROOT 447 | E 448 | Root object 449 | 450 | 451 | 452 | 453 | 454 | -------------------------------------------------------------------------------- /src/yy_lib_registry.prog.abap: -------------------------------------------------------------------------------- 1 | *&---------------------------------------------------------------------* 2 | *& Include YY_LIB_REGISTRY 3 | *&---------------------------------------------------------------------* 4 | *& Was: Include ZLIBREGISTRY 5 | * Implementation of a registry for storing arbitrary values (similar to the MS Windows registry) 6 | * Author: Martin Ceronio (2015), http://ceronio.net 7 | * Released under MIT License: http://opensource.org/licenses/MIT 8 | 9 | CLASS lcx_registry_err DEFINITION INHERITING FROM cx_dynamic_check. 10 | ENDCLASS. "lcx_registry_err DEFINITION 11 | 12 | *----------------------------------------------------------------------* 13 | * CLASS lcx_registry_lock DEFINITION 14 | *----------------------------------------------------------------------* 15 | CLASS lcx_registry_lock DEFINITION INHERITING FROM lcx_registry_err. 16 | ENDCLASS. "lcx_registry_lock DEFINITION 17 | 18 | *----------------------------------------------------------------------* 19 | * CLASS lcx_registry_noentry DEFINITION 20 | *----------------------------------------------------------------------* 21 | CLASS lcx_registry_noentry DEFINITION INHERITING FROM lcx_registry_err. 22 | ENDCLASS. "lcx_registry_noentry DEFINITION 23 | 24 | *----------------------------------------------------------------------* 25 | * CLASS lcx_registry_entry_exists DEFINITION 26 | *----------------------------------------------------------------------* 27 | CLASS lcx_registry_entry_exists DEFINITION INHERITING FROM lcx_registry_err. 28 | ENDCLASS. "lcx_registry_entry_exists DEFINITION 29 | 30 | *----------------------------------------------------------------------* 31 | * CLASS lcx_registry_entry_deleted DEFINITION 32 | *----------------------------------------------------------------------* 33 | CLASS lcx_registry_entry_deleted DEFINITION INHERITING FROM lcx_registry_err. 34 | ENDCLASS. "lcx_registry_entry_deleted DEFINITION 35 | 36 | *----------------------------------------------------------------------* 37 | * CLASS lcx_registry_invalid_char DEFINITION 38 | *----------------------------------------------------------------------* 39 | CLASS lcx_registry_invalid_char DEFINITION INHERITING FROM lcx_registry_err. 40 | ENDCLASS. "lcx_registry_invalid_char DEFINITION 41 | 42 | CLASS lcl_registry_lock DEFINITION. 43 | PUBLIC SECTION. 44 | METHODS: 45 | constructor 46 | IMPORTING key TYPE indx_srtfd, 47 | set_optimistic 48 | RAISING lcx_registry_lock, 49 | promote 50 | RAISING lcx_registry_lock, 51 | release. 52 | 53 | METHODS 54 | get_uuid RETURNING VALUE(rv_uuid) TYPE sysuuid_c22 55 | RAISING lcx_registry_err. 56 | PRIVATE SECTION. 57 | DATA internal_key TYPE indx_srtfd. 58 | ENDCLASS. 59 | *----------------------------------------------------------------------* 60 | * CLASS lcl_registry_entry DEFINITION 61 | *----------------------------------------------------------------------* 62 | * 63 | *----------------------------------------------------------------------* 64 | CLASS lcl_registry_entry DEFINITION CREATE PROTECTED. 65 | 66 | PUBLIC SECTION. 67 | * Predefined key for the registry root: 68 | CLASS-DATA registry_root TYPE indx_srtfd READ-ONLY VALUE 'REGISTRY_ROOT'. 69 | 70 | TYPES: BEGIN OF ts_keyval, 71 | key TYPE string, 72 | value TYPE string, 73 | END OF ts_keyval. 74 | TYPES: tt_keyval TYPE SORTED TABLE OF ts_keyval WITH UNIQUE KEY key. 75 | 76 | * For keeping track of references to sub-entries, we maintain a shadow 77 | * table with the same keys 78 | TYPES: BEGIN OF ts_keyobj, 79 | key TYPE string, 80 | value TYPE REF TO lcl_registry_entry, 81 | END OF ts_keyobj. 82 | TYPES: tt_keyobj TYPE SORTED TABLE OF ts_keyobj WITH UNIQUE KEY key. 83 | 84 | DATA sub_entries TYPE tt_keyval READ-ONLY. 85 | DATA values TYPE tt_keyval READ-ONLY. 86 | DATA internal_key TYPE indx_srtfd READ-ONLY. 87 | DATA parent_key TYPE indx_srtfd READ-ONLY. 88 | DATA entry_id TYPE string READ-ONLY. "User-friendly ID of the subnode 89 | 90 | METHODS: 91 | constructor 92 | IMPORTING internal_key TYPE any, 93 | reload 94 | RAISING lcx_registry_noentry, 95 | * lock raising lcx_registry_err, 96 | * Saves entry and all dirty sub-entries 97 | save RAISING lcx_registry_err, 98 | 99 | get_parent 100 | RETURNING VALUE(parent) TYPE REF TO lcl_registry_entry, 101 | 102 | create_by_path 103 | IMPORTING path TYPE string 104 | RETURNING VALUE(entry) TYPE REF TO lcl_registry_entry 105 | RAISING lcx_registry_err, 106 | 107 | *--------------------------------------------------------------------* 108 | * Methods dealing with sub-entries of the registry entry 109 | get_subentry 110 | IMPORTING key TYPE clike 111 | RETURNING VALUE(entry) TYPE REF TO lcl_registry_entry, 112 | add_subentry 113 | IMPORTING key TYPE clike 114 | RETURNING VALUE(entry) TYPE REF TO lcl_registry_entry 115 | RAISING lcx_registry_entry_exists, 116 | * Removes sub-entry and all entries underneath 117 | remove_subentry 118 | IMPORTING key TYPE clike 119 | RAISING lcx_registry_err, 120 | remove_subentries 121 | RAISING lcx_registry_err, 122 | copy_subentry 123 | IMPORTING source_key TYPE clike 124 | target_key TYPE clike 125 | RETURNING VALUE(target_entry) TYPE REF TO lcl_registry_entry 126 | RAISING lcx_registry_err, 127 | 128 | get_subentry_keys 129 | RETURNING VALUE(keys) TYPE string_table, 130 | 131 | get_subentries 132 | RETURNING VALUE(sub_entries) TYPE tt_keyobj, 133 | 134 | * Methods for dealing with values in the registry entry: 135 | 136 | * Get keys of all values 137 | get_value_keys 138 | RETURNING VALUE(keys) TYPE string_table, 139 | * Get all values 140 | get_values 141 | RETURNING VALUE(values) TYPE tt_keyval, 142 | * Set all values in one go: 143 | set_values 144 | IMPORTING values TYPE tt_keyval, 145 | * Get single value by key 146 | get_value 147 | IMPORTING key TYPE clike 148 | RETURNING VALUE(value) TYPE string 149 | RAISING lcx_registry_noentry, 150 | * Set/overwrite single value 151 | set_value 152 | IMPORTING key TYPE clike 153 | value TYPE any, 154 | * Delete single value by key 155 | delete_value 156 | IMPORTING key TYPE clike. 157 | 158 | 159 | CLASS-METHODS: 160 | get_entry_by_internal_key 161 | IMPORTING key TYPE any 162 | RETURNING VALUE(entry) TYPE REF TO lcl_registry_entry, 163 | get_root 164 | RETURNING VALUE(root) TYPE REF TO lcl_registry_entry. 165 | 166 | PROTECTED SECTION. 167 | 168 | METHODS: 169 | copy_subentry_deep 170 | IMPORTING source TYPE REF TO lcl_registry_entry 171 | target TYPE REF TO lcl_registry_entry, 172 | * Remove the registry entry from the database: 173 | * The DELETE method is protected because you must always delete an entry 174 | * as the sub-entry of its parent so that the link is removed from the 175 | * parent 176 | delete 177 | RAISING lcx_registry_err. 178 | 179 | DATA deleted TYPE abap_bool. 180 | 181 | CLASS-DATA lock TYPE REF TO lcl_registry_lock. 182 | 183 | * Class-wide buffer of instances of registry entries 184 | CLASS-DATA registry_entries TYPE tt_keyobj. 185 | 186 | 187 | ENDCLASS. "lcl_registry_entry DEFINITION 188 | 189 | *----------------------------------------------------------------------* 190 | * CLASS lcl_registry_entry IMPLEMENTATION 191 | *----------------------------------------------------------------------* 192 | * 193 | *----------------------------------------------------------------------* 194 | CLASS lcl_registry_entry IMPLEMENTATION. 195 | 196 | *--------------------------------------------------------------------* 197 | * CONSTRUCTOR - new instance of registry key 198 | *--------------------------------------------------------------------* 199 | METHOD constructor. 200 | me->internal_key = internal_key. 201 | 202 | lock = NEW lcl_registry_lock( me->internal_key ). 203 | 204 | * Load the entry from the database 205 | reload( ). 206 | 207 | * Object inserts itself into registry of entries 208 | INSERT VALUE ts_keyobj( key = me->internal_key 209 | value = me ) INTO TABLE registry_entries. 210 | ENDMETHOD. "constructor 211 | 212 | *--------------------------------------------------------------------* 213 | * RELOAD - reload values and sub-entries from database, set new lock 214 | *--------------------------------------------------------------------* 215 | METHOD reload. 216 | * Reload the values and sub-entries from the database 217 | IMPORT values = me->values 218 | sub_entries = me->sub_entries 219 | parent = parent_key 220 | entry_id = entry_id FROM DATABASE indx(zr) ID internal_key. 221 | IF sy-subrc NE 0. 222 | RAISE EXCEPTION TYPE lcx_registry_noentry. 223 | ENDIF. 224 | 225 | lock->set_optimistic( ). 226 | ENDMETHOD. "reload 227 | 228 | *--------------------------------------------------------------------* 229 | * GET_ROOT - retrieve root entry of registry 230 | *--------------------------------------------------------------------* 231 | METHOD get_root. 232 | * If the root doesn't exist yet, create it 233 | DATA values TYPE tt_keyval. 234 | DATA sub_entries TYPE tt_keyval. 235 | DATA parent_key TYPE indx_srtfd VALUE space. 236 | DATA entry_id TYPE string. 237 | 238 | IMPORT values = values 239 | sub_entries = sub_entries FROM DATABASE indx(zr) ID registry_root. 240 | IF sy-subrc NE 0. 241 | entry_id = registry_root. 242 | EXPORT values = values 243 | sub_entries = sub_entries 244 | parent = parent_key 245 | entry_id = entry_id TO DATABASE indx(zr) ID registry_root. 246 | ENDIF. 247 | 248 | * Retrieve the root entry of the registry 249 | root = get_entry_by_internal_key( registry_root ). 250 | 251 | ENDMETHOD. "get_root 252 | 253 | *--------------------------------------------------------------------* 254 | * GET_ENTRY_BY_INTERNAL_KEY - retrieve reg. entry by internal ID 255 | *--------------------------------------------------------------------* 256 | METHOD get_entry_by_internal_key. 257 | * Search global index of registry entry instances 258 | 259 | entry = VALUE #( registry_entries[ key = key ]-value DEFAULT 260 | NEW #( internal_key = key ) ). " will insert itself in registry 261 | 262 | ENDMETHOD. "get_entry_by_internal_key 263 | 264 | *--------------------------------------------------------------------* 265 | * CREATE_BY_PATH - convenience method, analogous to mkdir -p that 266 | * allows you to create a path of registry entries if they do not yet 267 | * exist; paths must be separated by forward slash ('/') 268 | * Sub-entries are created from the current registry entry 269 | *--------------------------------------------------------------------* 270 | METHOD create_by_path. 271 | DATA sub_entry TYPE REF TO lcl_registry_entry. 272 | 273 | SPLIT path AT '/' INTO TABLE DATA(keys). 274 | 275 | entry = me. 276 | LOOP AT keys INTO DATA(key) WHERE table_line IS NOT INITIAL. 277 | sub_entry = entry->get_subentry( key ). 278 | IF sub_entry IS NOT BOUND. 279 | sub_entry = entry->add_subentry( key ). 280 | ENDIF. 281 | entry = sub_entry. 282 | ENDLOOP. 283 | * After successful processing of chain, ENTRY will contain the last-created node 284 | 285 | ENDMETHOD. "create_by_path 286 | 287 | *--------------------------------------------------------------------* 288 | * GET_PARENT - retrieve parent entry of this entry 289 | *--------------------------------------------------------------------* 290 | METHOD get_parent. 291 | * Return the parent of the current key 292 | parent = get_entry_by_internal_key( parent_key ). 293 | ENDMETHOD. "get_parent 294 | 295 | *--------------------------------------------------------------------* 296 | * GET_SUBENTRY - return single child entry by key 297 | *--------------------------------------------------------------------* 298 | METHOD get_subentry. 299 | 300 | CLEAR entry. 301 | * Read internal store of sub-entries 302 | CHECK line_exists( sub_entries[ key = key ] ). 303 | 304 | DATA(lv_value) = sub_entries[ key = key ]-value. 305 | 306 | * Search global index of registry entry instances 307 | * read table sub_entrobj into ko with key key = kv-value. 308 | 309 | entry = VALUE #( registry_entries[ key = lv_value ]-value 310 | DEFAULT NEW #( internal_key = lv_value ) ). 311 | * Create new reference to sub-entry, Will insert itself into registry entries 312 | 313 | ENDMETHOD. "get_subentry 314 | 315 | *--------------------------------------------------------------------* 316 | * GET_SUBENTRIES - return immediate children registry entries 317 | *--------------------------------------------------------------------* 318 | METHOD get_subentries. 319 | LOOP AT get_subentry_keys( ) INTO DATA(subkey). 320 | INSERT VALUE #( key = subkey 321 | value = get_subentry( subkey ) ) INTO TABLE sub_entries. 322 | ENDLOOP. 323 | ENDMETHOD. "get_subentries 324 | 325 | DEFINE validate. 326 | * Prevent any changes if this entry is marked as deleted 327 | IF deleted = abap_true. 328 | RAISE EXCEPTION TYPE lcx_registry_entry_deleted. 329 | ENDIF. 330 | END-OF-DEFINITION. 331 | 332 | *--------------------------------------------------------------------* 333 | * ADD_SUBENTRY - add a child entry with new key and save 334 | *--------------------------------------------------------------------* 335 | METHOD add_subentry. 336 | validate. 337 | 338 | * Check that only allowed characters are used. Will help for making 339 | * sensible paths and string handling in other applications 340 | * Most of all, we want to avoid spaces and slashes (although those 341 | * square and curly brackets could cause problems for JSON...) 342 | IF NOT key CO 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890@#$%^_+-(){}[]'. 343 | RAISE EXCEPTION TYPE lcx_registry_invalid_char. 344 | ENDIF. 345 | 346 | * Read internal store of sub-entries 347 | IF line_exists( sub_entries[ key = key ] ). 348 | RAISE EXCEPTION TYPE lcx_registry_entry_exists. 349 | ENDIF. 350 | 351 | DATA(lv_value) = lock->get_uuid( ). 352 | INSERT VALUE #( key = key 353 | value = lv_value ) INTO TABLE sub_entries. 354 | 355 | * Create an entry on the database for the new entry 356 | DATA lt_empty_vals TYPE tt_keyval. 357 | DATA lv_srtfd TYPE indx_srtfd. 358 | lv_srtfd = lv_value. 359 | 360 | EXPORT values = lt_empty_vals 361 | sub_entries = lt_empty_vals 362 | parent = internal_key 363 | entry_id = key TO DATABASE indx(zr) ID lv_srtfd. 364 | 365 | entry = NEW #( internal_key = lv_value ). 366 | * Will insert itself into registry entries 367 | 368 | ** Set current entry as the parent of the new entry 369 | * entry->parent_key = internal_key. 370 | ** Set short ID on the new entry 371 | * entry->entry_id = key. 372 | ** Save the new entry 373 | * entry->save( ). 374 | 375 | * Save the current entry to update the list of sub-keys 376 | save( ). 377 | 378 | ENDMETHOD. "add_subentry 379 | 380 | *--------------------------------------------------------------------* 381 | * COPY_SUBENTRY - copy a child registry entry at the same level, 382 | * including all values, by passing a source and target key 383 | *--------------------------------------------------------------------* 384 | METHOD copy_subentry. 385 | validate. 386 | 387 | DATA(source_entry) = get_subentry( source_key ). 388 | IF source_entry IS NOT BOUND. 389 | RAISE EXCEPTION TYPE lcx_registry_noentry. 390 | ENDIF. 391 | 392 | * Using the source and the new target, do a deep copy 393 | * that includes copies of sub-entries and values 394 | copy_subentry_deep( source = source_entry 395 | target = add_subentry( target_key ) ). 396 | 397 | ENDMETHOD. "copy_subentry 398 | 399 | *--------------------------------------------------------------------* 400 | * COPY_SUBENTRY_DEEP - (protected) - copy a branch of the registry 401 | * at the same level, including all values 402 | *--------------------------------------------------------------------* 403 | METHOD copy_subentry_deep. 404 | 405 | * Copy values from source to target 406 | target->values = source->values. 407 | 408 | * Copy sub-entries from source to target 409 | LOOP AT source->sub_entries INTO DATA(ls_subentry). 410 | copy_subentry_deep( source = source->get_subentry( ls_subentry-key ) 411 | target = target->add_subentry( ls_subentry-key ) ). 412 | ENDLOOP. 413 | 414 | * Ensure that values are also saved 415 | save( ). 416 | 417 | ENDMETHOD. "copy_subentry_deep 418 | 419 | *--------------------------------------------------------------------* 420 | * REMOVE_SUBENTRIES - remove all child entries of this entry 421 | *--------------------------------------------------------------------* 422 | METHOD remove_subentries. 423 | validate. 424 | 425 | LOOP AT sub_entries INTO DATA(kv). 426 | remove_subentry( kv-key ). 427 | ENDLOOP. 428 | ENDMETHOD. "remove_subentries 429 | 430 | *--------------------------------------------------------------------* 431 | * DELETE - delete the current entry from the database and mark it, 432 | * preventing any further operations on this entry 433 | *--------------------------------------------------------------------* 434 | METHOD delete. 435 | validate. 436 | 437 | * Delete all sub-entries before deleting this entry 438 | LOOP AT sub_entries INTO DATA(sub_entry). 439 | get_subentry( sub_entry-key )->delete( ). 440 | DELETE sub_entries. 441 | ENDLOOP. 442 | 443 | * Remove DB entry for the current entry 444 | lock->promote( ). 445 | DELETE FROM DATABASE indx(zr) ID internal_key. 446 | * Object removes itself from the global table too so that that reference no longer exists 447 | DELETE registry_entries WHERE key = internal_key. 448 | * Set the object to deleted to prevent any operations on any remaining references to the object 449 | deleted = abap_true. 450 | 451 | * Release lock held on this key 452 | lock->release( ). 453 | 454 | ENDMETHOD. "delete 455 | 456 | *--------------------------------------------------------------------* 457 | * REMOVE_SUBENTRY - remove a single child registry entry by key 458 | *--------------------------------------------------------------------* 459 | METHOD remove_subentry. 460 | validate. 461 | 462 | * Read internal store of sub-entries 463 | IF NOT line_exists( sub_entries[ key = key ] ). 464 | * Entry does not exist; exit with error 465 | RAISE EXCEPTION TYPE lcx_registry_noentry. 466 | ENDIF. 467 | 468 | * Remove all sub-entries of the sub-entry before removing the sub-entry 469 | DATA(sub_entry) = get_subentry( key ). 470 | CHECK sub_entry IS BOUND. 471 | 472 | * Delete the sub_entry (which deletes its sub-entries) 473 | sub_entry->delete( ). 474 | * Remove entry from sub-entry table and shadow table 475 | DELETE sub_entries WHERE key = key. 476 | 477 | save( ). "Save current entry to remove subentry that has been removed 478 | 479 | ENDMETHOD. "remove_subentry 480 | 481 | *--------------------------------------------------------------------* 482 | * SAVE - save the current entry, with concurrency control 483 | *--------------------------------------------------------------------* 484 | METHOD save. 485 | validate. 486 | 487 | lock->promote( ). 488 | EXPORT values = me->values 489 | sub_entries = me->sub_entries 490 | parent = parent_key 491 | entry_id = entry_id TO DATABASE indx(zr) ID internal_key. 492 | lock->set_optimistic( ). 493 | ENDMETHOD. "save 494 | 495 | *--------------------------------------------------------------------* 496 | * GET_SUBENTRY_KEYS - retrieve keys of all child registry entries 497 | *--------------------------------------------------------------------* 498 | METHOD get_subentry_keys. 499 | keys = VALUE #( FOR kv IN sub_entries ( kv-key ) ). 500 | ENDMETHOD. "get_subentry_keys 501 | 502 | *--------------------------------------------------------------------* 503 | * GET_VALUE_KEYS - retrieve keys of all values 504 | *--------------------------------------------------------------------* 505 | METHOD get_value_keys. 506 | keys = VALUE #( FOR kv IN values ( kv-key ) ). 507 | ENDMETHOD. "get_value_keys 508 | 509 | *--------------------------------------------------------------------* 510 | * GET_VALUES - retrieve all values at once in key+value table 511 | *--------------------------------------------------------------------* 512 | METHOD get_values. 513 | values = me->values. 514 | ENDMETHOD. "get_values 515 | 516 | *--------------------------------------------------------------------* 517 | * SET_VALUES - set all values at once with key+value table 518 | *--------------------------------------------------------------------* 519 | METHOD set_values. 520 | validate. 521 | 522 | me->values = values. 523 | ENDMETHOD. "set_values 524 | 525 | *--------------------------------------------------------------------* 526 | * GET_VALUE - return a single value by key 527 | *--------------------------------------------------------------------* 528 | METHOD get_value. 529 | TRY. 530 | value = values[ key = key ]-value. 531 | CATCH cx_sy_itab_line_not_found. 532 | RAISE EXCEPTION TYPE lcx_registry_noentry. 533 | ENDTRY. 534 | ENDMETHOD. "get_value 535 | 536 | METHOD set_value. 537 | validate. 538 | 539 | * Add the value to set of values if not existing or change if it does exist 540 | READ TABLE values INTO DATA(kv) WITH KEY key = key. 541 | IF sy-subrc NE 0. 542 | INSERT VALUE #( key = key 543 | value = value ) INTO TABLE values. 544 | ELSE. 545 | kv-value = value. 546 | MODIFY TABLE values FROM kv. 547 | ENDIF. 548 | ENDMETHOD. "set_value 549 | 550 | METHOD delete_value. 551 | validate. 552 | 553 | DELETE values WHERE key = key. 554 | ENDMETHOD. "delete_value 555 | 556 | ENDCLASS. "lcl_registry_entry IMPLEMENTATION 557 | 558 | CLASS lcl_registry_lock IMPLEMENTATION. 559 | 560 | ********************************************************************** 561 | * CONCURRENCY HELPER METHODS 562 | ********************************************************************** 563 | METHOD constructor. 564 | super->constructor( ). 565 | internal_key = key. 566 | ENDMETHOD. 567 | 568 | *--------------------------------------------------------------------* 569 | * SET_OPTIMISTIC_LOCK - always set when (re-)reading an entry 570 | *--------------------------------------------------------------------* 571 | METHOD set_optimistic. 572 | * Existing lock must be released before acquiring a new one 573 | release( ). 574 | CALL FUNCTION 'ENQUEUE_ESINDX' 575 | EXPORTING 576 | mode_indx = 'O' 577 | relid = 'ZR' 578 | srtfd = internal_key 579 | EXCEPTIONS 580 | foreign_lock = 1 581 | system_failure = 2 582 | OTHERS = 3. 583 | IF sy-subrc <> 0. 584 | RAISE EXCEPTION TYPE lcx_registry_lock. 585 | ENDIF. 586 | ENDMETHOD. "set_optimistic_lock 587 | 588 | *--------------------------------------------------------------------* 589 | * PROMOTE_LOCK - Get exclusive lock just before saving 590 | *--------------------------------------------------------------------* 591 | METHOD promote. 592 | CALL FUNCTION 'ENQUEUE_ESINDX' 593 | EXPORTING 594 | mode_indx = 'R' 595 | relid = 'ZR' 596 | srtfd = internal_key 597 | EXCEPTIONS 598 | foreign_lock = 1 599 | system_failure = 2 600 | OTHERS = 3. 601 | IF sy-subrc <> 0. 602 | RAISE EXCEPTION TYPE lcx_registry_lock. 603 | ENDIF. 604 | ENDMETHOD. "promote_lock 605 | 606 | *--------------------------------------------------------------------* 607 | * RELEASE_LOCK - called after deleting or before re-acquiring 608 | *--------------------------------------------------------------------* 609 | METHOD release. 610 | CALL FUNCTION 'DEQUEUE_ESINDX' 611 | EXPORTING 612 | relid = 'ZR' 613 | srtfd = internal_key. 614 | ENDMETHOD. "release_lock 615 | 616 | METHOD get_uuid. 617 | * Create unique ID for key in INDX for the new entry 618 | TRY. 619 | rv_uuid = cl_system_uuid=>create_uuid_c22_static( ). 620 | CATCH cx_uuid_error. 621 | RAISE EXCEPTION TYPE lcx_registry_err. 622 | ENDTRY. 623 | ENDMETHOD. 624 | 625 | ENDCLASS. 626 | -------------------------------------------------------------------------------- /src/zz_registry_browser.prog.abap: -------------------------------------------------------------------------------- 1 | *&---------------------------------------------------------------------* 2 | *& Report ZZ_REGISTRY_BROWSER 3 | *&---------------------------------------------------------------------* 4 | *& was Report ZUSR_REGISTRY_BROWSER 5 | *&---------------------------------------------------------------------* 6 | *& Viewer and editor for registry stored in INDX 7 | *& (requires ZLIB_REGISTRY) 8 | *&---------------------------------------------------------------------* 9 | * Author: Martin Ceronio (2015), http://ceronio.net 10 | * Released under MIT License: http://opensource.org/licenses/MIT 11 | REPORT zz_registry_browser. 12 | 13 | INCLUDE yy_lib_registry. 14 | 15 | * For tree control: 16 | DATA: gr_tree TYPE REF TO cl_gui_alv_tree. 17 | DATA: gr_tree_toolbar TYPE REF TO cl_gui_toolbar. 18 | DATA: gs_node_layout TYPE lvc_s_layn. "Layout for new nodes 19 | * Table for registry entries on tree 20 | TYPES: BEGIN OF ts_tab, 21 | key TYPE string, 22 | reg_entry TYPE REF TO lcl_registry_entry, 23 | END OF ts_tab. 24 | * Container for ALV tree data: 25 | DATA: gt_tab TYPE TABLE OF ts_tab. 26 | 27 | * For maintaining registry values in an an entry (ALV control): 28 | DATA: gr_table TYPE REF TO cl_gui_alv_grid. 29 | DATA: gt_value TYPE STANDARD TABLE OF lcl_registry_entry=>ts_keyval. 30 | DATA: gt_value_ori TYPE STANDARD TABLE OF lcl_registry_entry=>ts_keyval. "Original data 31 | 32 | * For splitter container 33 | DATA: gr_splitter TYPE REF TO cl_gui_easy_splitter_container. 34 | 35 | * For registry access: 36 | DATA: gr_reg_root TYPE REF TO lcl_registry_entry. 37 | 38 | DATA: gr_sel_reg_entry TYPE REF TO lcl_registry_entry. "Selected reg. entry 39 | DATA: gv_sel_node_key TYPE lvc_nkey. "Tree node key of currently selected node 40 | 41 | * Single statement to generate a selection screen 42 | PARAMETERS: dummy. 43 | 44 | *----------------------------------------------------------------------* 45 | * CLASS event_handler DEFINITION 46 | *----------------------------------------------------------------------* 47 | CLASS event_handler DEFINITION. 48 | PUBLIC SECTION. 49 | CLASS-METHODS: 50 | handle_node_expand FOR EVENT expand_nc OF cl_gui_alv_tree 51 | IMPORTING node_key sender, 52 | handle_table_toolbar FOR EVENT toolbar OF cl_gui_alv_grid 53 | IMPORTING e_object e_interactive sender, 54 | handle_table_command FOR EVENT user_command OF cl_gui_alv_grid 55 | IMPORTING e_ucomm, 56 | handle_node_selected FOR EVENT selection_changed OF cl_gui_alv_tree 57 | IMPORTING node_key, 58 | handle_tree_command FOR EVENT function_selected OF cl_gui_toolbar 59 | IMPORTING fcode. 60 | * handle_values_changed for event DATA_CHANGE of CL_GUI_ALV_GRID 61 | * importing er_data_changed e_onf4 e_onf4_before e_onf4_after e_ucomm. 62 | 63 | ENDCLASS. "event_handler DEFINITION 64 | 65 | *----------------------------------------------------------------------* 66 | * CLASS event_handler IMPLEMENTATION 67 | *----------------------------------------------------------------------* 68 | CLASS event_handler IMPLEMENTATION. 69 | 70 | * Handle commands to the tree toolbar 71 | METHOD handle_tree_command. 72 | DATA: lv_new_key TYPE string. 73 | DATA: lr_reg_entry TYPE REF TO lcl_registry_entry. 74 | DATA: lv_node_key TYPE lvc_nkey. 75 | DATA: lv_rc TYPE char1. 76 | DATA: lv_ntext TYPE lvc_value. 77 | DATA: ls_tab TYPE ts_tab. 78 | 79 | IF gr_sel_reg_entry IS NOT BOUND. 80 | MESSAGE 'Select a node from the tree first' TYPE 'I'. 81 | RETURN. 82 | ENDIF. 83 | 84 | * Create a new node under selected node, or copy a registry node on the same level 85 | IF fcode = 'INSE'. 86 | 87 | * Dialog to capture name of new node 88 | PERFORM value_input_dialog USING 'New registry entry key'(007) 89 | CHANGING lv_new_key lv_rc. 90 | 91 | * Add the new key to the current registry entry if the user accepts 92 | IF lv_rc = space. 93 | TRY. 94 | * Update the tree by adding the new node 95 | gr_sel_reg_entry->add_subentry( lv_new_key ). 96 | PERFORM refresh_subnodes USING gv_sel_node_key. 97 | 98 | CATCH lcx_registry_entry_exists. 99 | MESSAGE 'The registry entry already exists'(015) TYPE 'I'. 100 | RETURN. 101 | ENDTRY. 102 | ENDIF. 103 | 104 | * Copy the selected node at the same level 105 | ELSEIF fcode = 'COPY'. 106 | 107 | * Dialog to capture name of new node 108 | PERFORM value_input_dialog USING 'Target registry entry key'(006) 109 | CHANGING lv_new_key lv_rc. 110 | 111 | * Perform deep copy of source to target node 112 | IF lv_rc = space. 113 | DATA: lr_parent TYPE REF TO lcl_registry_entry. 114 | TRY. 115 | lr_parent = gr_sel_reg_entry->get_parent( ). 116 | lr_parent->copy_subentry( source_key = gr_sel_reg_entry->entry_id target_key = lv_new_key ). 117 | 118 | * Get the parent node in the tree to refresh it 119 | CALL METHOD gr_tree->get_parent 120 | EXPORTING 121 | i_node_key = gv_sel_node_key 122 | IMPORTING 123 | e_parent_node_key = lv_node_key. 124 | 125 | * Refresh the parent node 126 | PERFORM refresh_subnodes USING lv_node_key. 127 | 128 | CATCH lcx_registry_entry_exists. 129 | MESSAGE 'The registry entry already exists'(015) TYPE 'I'. 130 | RETURN. 131 | CATCH lcx_registry_err. 132 | MESSAGE 'Error updating registry'(017) TYPE 'I'. 133 | RETURN. 134 | ENDTRY. 135 | ENDIF. 136 | 137 | * Delete the selected node from the registry 138 | ELSEIF fcode = 'DELE'. 139 | 140 | * Prevent deleting of the root entity, which would fail anyway when we try get its parent 141 | IF gr_sel_reg_entry->internal_key = lcl_registry_entry=>registry_root. 142 | MESSAGE 'Root node cannot be deleted' TYPE 'I'. 143 | RETURN. 144 | ENDIF. 145 | 146 | CALL FUNCTION 'POPUP_TO_CONFIRM' 147 | EXPORTING 148 | titlebar = 'Confirm deletion'(009) 149 | text_question = 'Are you sure you want to delete the selected entry?'(010) 150 | display_cancel_button = abap_false 151 | IMPORTING 152 | answer = lv_rc 153 | EXCEPTIONS 154 | text_not_found = 1 155 | OTHERS = 2. 156 | IF sy-subrc <> 0. 157 | * Won't happen 158 | ENDIF. 159 | 160 | * Check that the user selected OK on the confirmation 161 | CHECK lv_rc = '1'. 162 | 163 | lr_reg_entry = gr_sel_reg_entry->get_parent( ). 164 | CHECK lr_reg_entry IS BOUND. 165 | lr_reg_entry->remove_subentry( gr_sel_reg_entry->entry_id ). 166 | 167 | * Get the parent node in the tree to refresh it 168 | CALL METHOD gr_tree->get_parent 169 | EXPORTING 170 | i_node_key = gv_sel_node_key 171 | IMPORTING 172 | e_parent_node_key = lv_node_key. 173 | 174 | * Refresh the parent node 175 | PERFORM refresh_subnodes USING lv_node_key. 176 | 177 | ENDIF. 178 | 179 | ENDMETHOD. "handle_tree_command 180 | 181 | * Handle commands on the values table 182 | METHOD handle_table_command. 183 | DATA: lv_node_key TYPE lvc_nkey. 184 | DATA: ls_tab TYPE ts_tab. 185 | DATA: lt_value TYPE lcl_registry_entry=>tt_keyval. 186 | DATA: ls_value TYPE lcl_registry_entry=>ts_keyval. 187 | 188 | * Save current values 189 | IF e_ucomm = 'SAVE'. 190 | PERFORM save_values. 191 | ENDIF. 192 | ENDMETHOD. "handle_table_command 193 | 194 | * Handle selection of a node in the tree 195 | METHOD handle_node_selected. 196 | DATA: ls_tab TYPE ts_tab. 197 | DATA: lt_val TYPE lcl_registry_entry=>tt_keyval. 198 | 199 | * Check whether data has changed before 200 | DATA: lv_answer TYPE char01. 201 | DATA: lv_refresh TYPE char01. 202 | * Check for changed data. The CHECK_CHANGED_DATA() method and 203 | * neither the DATA_CHANGED or DATA_CHANGED_FINISHED 204 | * events of CL_GUI_ALV_GRID seem to fit the bill, so we keep our own copy 205 | * of the original data and compare it 206 | IF gr_table IS BOUND. 207 | * Refresh data in local table (GT_VALUE) 208 | CALL METHOD gr_table->check_changed_data. 209 | 210 | IF gt_value NE gt_value_ori. 211 | CALL FUNCTION 'POPUP_TO_CONFIRM' 212 | EXPORTING 213 | titlebar = 'Confirm data loss'(017) 214 | text_question = 'Data has changed. Save first?'(018) 215 | display_cancel_button = abap_false 216 | IMPORTING 217 | answer = lv_answer 218 | EXCEPTIONS 219 | text_not_found = 1 220 | OTHERS = 2. 221 | IF sy-subrc <> 0. 222 | * Not going to happen; not using a text 223 | ENDIF. 224 | 225 | IF lv_answer = '1'. "Save data before moving on 226 | PERFORM save_values. 227 | ENDIF. 228 | 229 | ENDIF. 230 | 231 | ENDIF. 232 | 233 | * Set up the table 234 | IF gr_table IS NOT BOUND. 235 | PERFORM create_table. 236 | ENDIF. 237 | 238 | CALL METHOD gr_tree->get_outtab_line 239 | EXPORTING 240 | i_node_key = node_key 241 | IMPORTING 242 | e_outtab_line = ls_tab " Line of Outtab 243 | EXCEPTIONS 244 | node_not_found = 1 245 | OTHERS = 2. 246 | IF sy-subrc <> 0. 247 | MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno 248 | WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4. 249 | ENDIF. 250 | 251 | * Read the values of the selected registry entry 252 | gt_value = ls_tab-reg_entry->get_values( ). 253 | gt_value_ori = gt_value. "Store last values 254 | * Ensure column widths are correct on every update 255 | * Settings on table 256 | * data: ls_layout type lvc_s_layo. 257 | * ls_layout-cwidth_opt = abap_true. 258 | * gr_table->set_frontend_layout( ls_layout ). 259 | gr_table->refresh_table_display( ). 260 | * Keep track of selected reg. entry for update 261 | gr_sel_reg_entry = ls_tab-reg_entry. 262 | gv_sel_node_key = node_key. 263 | 264 | ENDMETHOD. "handle_node_selected 265 | 266 | * Expand nodes of the registry tree to add sub-entries 267 | METHOD handle_node_expand. 268 | DATA: lr_reg_entry TYPE REF TO lcl_registry_entry. 269 | DATA: ls_tab TYPE ts_tab. 270 | 271 | CALL METHOD sender->get_outtab_line 272 | EXPORTING 273 | i_node_key = node_key 274 | IMPORTING 275 | e_outtab_line = ls_tab " Line of Outtab 276 | EXCEPTIONS 277 | node_not_found = 1 278 | OTHERS = 2. 279 | IF sy-subrc <> 0. 280 | MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno 281 | WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4. 282 | ENDIF. 283 | 284 | DATA: lt_sub_entries TYPE lcl_registry_entry=>tt_keyobj. 285 | DATA: ls_sub_entry TYPE lcl_registry_entry=>ts_keyobj. 286 | DATA: lv_expander TYPE abap_bool. 287 | DATA: lv_node_text TYPE lvc_value. 288 | 289 | * Add sub-entries to selected node in tree 290 | lt_sub_entries = ls_tab-reg_entry->get_subentries( ). 291 | LOOP AT lt_sub_entries INTO ls_sub_entry. 292 | 293 | lr_reg_entry = ls_sub_entry-value. 294 | PERFORM add_node USING node_key lr_reg_entry. 295 | 296 | ENDLOOP. 297 | 298 | ENDMETHOD. "EXPAND_EMPTY_FOLDER 299 | 300 | * Modify toolbar entries for table/grid 301 | METHOD handle_table_toolbar. 302 | DATA: ls_tbe TYPE stb_button. 303 | * Keep only the local editing features 304 | LOOP AT e_object->mt_toolbar INTO ls_tbe. 305 | IF ls_tbe-function(7) NE '&LOCAL&'. 306 | DELETE e_object->mt_toolbar. 307 | ENDIF. 308 | ENDLOOP. 309 | * Add a function for saving the values 310 | ls_tbe-function = 'SAVE'. 311 | ls_tbe-icon = '@2L@'. 312 | ls_tbe-butn_type = '0'. 313 | ls_tbe-quickinfo = 'Save'. 314 | APPEND ls_tbe TO e_object->mt_toolbar. 315 | ENDMETHOD. "handle_table_toolbar 316 | 317 | ENDCLASS. "event_handler IMPLEMENTATION 318 | 319 | *&---------------------------------------------------------------------* 320 | *& Form refresh_subnodes 321 | *&---------------------------------------------------------------------* 322 | * Delete and refresh subnodes of a node 323 | *----------------------------------------------------------------------* 324 | FORM refresh_subnodes USING pv_nkey TYPE lvc_nkey. 325 | DATA: ls_tab TYPE ts_tab. 326 | DATA: ls_subentry TYPE lcl_registry_entry=>ts_keyval. 327 | DATA: lr_reg_entry TYPE REF TO lcl_registry_entry. 328 | DATA: lt_children TYPE lvc_t_nkey. 329 | DATA: lv_nkey TYPE lvc_nkey. 330 | 331 | * Delete subnodes of node. This means: getting all children and deleting 332 | * them individually! 333 | CALL METHOD gr_tree->get_children 334 | EXPORTING 335 | i_node_key = pv_nkey 336 | IMPORTING 337 | et_children = lt_children 338 | EXCEPTIONS 339 | historic_error = 1 340 | node_key_not_found = 2 341 | OTHERS = 3. 342 | IF sy-subrc <> 0. 343 | MESSAGE 'Error building tree'(014) TYPE 'E'. 344 | ENDIF. 345 | 346 | LOOP AT lt_children INTO lv_nkey. 347 | 348 | CALL METHOD gr_tree->delete_subtree 349 | EXPORTING 350 | i_node_key = lv_nkey 351 | i_update_parents_expander = abap_true 352 | EXCEPTIONS 353 | node_key_not_in_model = 1 354 | OTHERS = 2. 355 | IF sy-subrc <> 0. 356 | MESSAGE 'Error building tree'(014) TYPE 'E'. 357 | ENDIF. 358 | 359 | ENDLOOP. 360 | 361 | * With the children deleted, proceed to re-add registry entries 362 | 363 | * Get the registry entry on the node 364 | CALL METHOD gr_tree->get_outtab_line 365 | EXPORTING 366 | i_node_key = pv_nkey 367 | IMPORTING 368 | e_outtab_line = ls_tab 369 | EXCEPTIONS 370 | node_not_found = 1 371 | OTHERS = 2. 372 | IF sy-subrc NE 0. 373 | MESSAGE 'Error building tree'(014) TYPE 'E'. 374 | ENDIF. 375 | * Add a subnode for each sub-entry 376 | LOOP AT ls_tab-reg_entry->sub_entries INTO ls_subentry. 377 | lr_reg_entry = ls_tab-reg_entry->get_subentry( ls_subentry-key ). 378 | PERFORM add_node USING pv_nkey lr_reg_entry. 379 | ENDLOOP. 380 | * Expand parent node 381 | CALL METHOD gr_tree->expand_node 382 | EXPORTING 383 | i_node_key = pv_nkey 384 | EXCEPTIONS 385 | failed = 1 386 | illegal_level_count = 2 387 | cntl_system_error = 3 388 | node_not_found = 4 389 | cannot_expand_leaf = 5 390 | OTHERS = 6. 391 | IF sy-subrc <> 0. 392 | MESSAGE 'Error building tree'(014) TYPE 'E'. 393 | ENDIF. 394 | * Update tree display 395 | gr_table->refresh_table_display( ). 396 | ENDFORM. "refresh_subnodes 397 | 398 | 399 | *&---------------------------------------------------------------------* 400 | *& Form save_values 401 | *&---------------------------------------------------------------------* 402 | * Save current values in table to currently selected reg. node 403 | *----------------------------------------------------------------------* 404 | FORM save_values. 405 | IF gr_table IS BOUND AND gr_sel_reg_entry IS BOUND. 406 | DATA: lt_value TYPE lcl_registry_entry=>tt_keyval. 407 | DATA: ls_value TYPE lcl_registry_entry=>ts_keyval. 408 | * Normalize the values; duplicate keys are overwritten, with possible loss of data! 409 | LOOP AT gt_value INTO ls_value. 410 | INSERT ls_value INTO TABLE lt_value. 411 | ENDLOOP. 412 | gr_sel_reg_entry->set_values( lt_value ). 413 | TRY. 414 | gr_sel_reg_entry->save( ). 415 | CATCH lcx_registry_lock. 416 | MESSAGE 'Values have been overwritten since last change and are refreshed'(004) TYPE 'I'. 417 | gr_sel_reg_entry->reload( ). 418 | gt_value = gr_sel_reg_entry->get_values( ). 419 | ENDTRY. 420 | gr_table->refresh_table_display( ). 421 | ENDIF. 422 | 423 | ENDFORM. "save_values 424 | 425 | *&---------------------------------------------------------------------* 426 | *& Form add_node 427 | *&---------------------------------------------------------------------* 428 | * Add single node to tree 429 | *----------------------------------------------------------------------* 430 | * -->PV_NKEY Node of tree to which to add node 431 | * -->PS_TAB Table entry (with reg. entry) to add as child 432 | *----------------------------------------------------------------------* 433 | FORM add_node 434 | USING pv_nkey TYPE lvc_nkey pr_regentry TYPE REF TO lcl_registry_entry. 435 | 436 | DATA: lv_node_text TYPE lvc_value. 437 | DATA: ls_node_layout TYPE lvc_s_layn. "Layout for new nodes 438 | DATA: ls_tab TYPE ts_tab. 439 | 440 | IF pr_regentry IS NOT BOUND. 441 | MESSAGE 'Error building tree'(014) TYPE 'E'. 442 | ENDIF. 443 | 444 | ls_tab-reg_entry = pr_regentry. 445 | 446 | * Add node as folder always 447 | ls_node_layout-isfolder = abap_true. 448 | * Add expander only if there are more sub-entries 449 | IF lines( pr_regentry->get_subentry_keys( ) ) > 0. 450 | ls_node_layout-expander = abap_true. 451 | ELSE. 452 | ls_node_layout-expander = abap_false. 453 | ENDIF. 454 | 455 | lv_node_text = pr_regentry->entry_id. 456 | 457 | CALL METHOD gr_tree->add_node 458 | EXPORTING 459 | i_relat_node_key = pv_nkey 460 | i_relationship = cl_gui_column_tree=>relat_last_child 461 | is_outtab_line = ls_tab 462 | i_node_text = lv_node_text 463 | is_node_layout = ls_node_layout 464 | EXCEPTIONS 465 | relat_node_not_found = 1 466 | node_not_found = 2 467 | OTHERS = 3. 468 | IF sy-subrc <> 0. 469 | MESSAGE 'Error building tree'(014) TYPE 'E'. 470 | ENDIF. 471 | 472 | ENDFORM. "add_node 473 | 474 | *&---------------------------------------------------------------------* 475 | *& Form create_table 476 | *&---------------------------------------------------------------------* 477 | * Initialize table for showing values in a registry entry 478 | *----------------------------------------------------------------------* 479 | FORM create_table RAISING cx_salv_msg. 480 | DATA: lr_func TYPE REF TO cl_salv_functions_list. 481 | DATA: lr_cols TYPE REF TO cl_salv_columns_table. 482 | 483 | DATA: lt_fcat TYPE lvc_t_fcat. 484 | DATA: ls_fcat TYPE lvc_s_fcat. 485 | 486 | CREATE OBJECT gr_table 487 | EXPORTING 488 | i_parent = gr_splitter->bottom_right_container 489 | i_appl_events = abap_true " Register Events as Application Events 490 | * i_fcat_complete = SPACE " Boolean Variable (X=True, Space=False) 491 | EXCEPTIONS 492 | error_cntl_create = 1 493 | error_cntl_init = 2 494 | error_cntl_link = 3 495 | error_dp_create = 4 496 | OTHERS = 5. 497 | IF sy-subrc <> 0. 498 | MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno 499 | WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4. 500 | ENDIF. 501 | 502 | * Add fields to catalog 503 | ls_fcat-fieldname = 'KEY'. 504 | ls_fcat-edit = abap_true. 505 | ls_fcat-key = abap_true. 506 | ls_fcat-scrtext_s = 'Key'(001). 507 | ls_fcat-outputlen = 35. "Because colwidth opt is not always great 508 | APPEND ls_fcat TO lt_fcat. 509 | ls_fcat-fieldname = 'VALUE'. 510 | ls_fcat-edit = abap_true. 511 | ls_fcat-key = abap_false. 512 | ls_fcat-scrtext_s = 'Value'(002). 513 | ls_fcat-outputlen = 35. "Because colwidth opt is not always great 514 | APPEND ls_fcat TO lt_fcat. 515 | 516 | gr_table->set_table_for_first_display( 517 | CHANGING 518 | it_outtab = gt_value[] 519 | it_fieldcatalog = lt_fcat 520 | EXCEPTIONS 521 | invalid_parameter_combination = 1 522 | program_error = 2 523 | too_many_lines = 3 524 | OTHERS = 4 ). 525 | IF sy-subrc <> 0. 526 | MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno 527 | WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4. 528 | ENDIF. 529 | 530 | * Toolbar to hold only functions for editing 531 | SET HANDLER event_handler=>handle_table_toolbar FOR gr_table. 532 | SET HANDLER event_handler=>handle_table_command FOR gr_table. 533 | gr_table->set_toolbar_interactive( ). 534 | 535 | ** Settings on table 536 | * data: ls_layout type lvc_s_layo. 537 | * ls_layout-cwidth_opt = abap_true. 538 | * gr_table->set_frontend_layout( ls_layout ). 539 | 540 | ENDFORM. "create_table 541 | 542 | *&---------------------------------------------------------------------* 543 | *& Form create_tree 544 | *&---------------------------------------------------------------------* 545 | * Initialize tree showing the registry hierarchy 546 | *----------------------------------------------------------------------* 547 | FORM create_tree. 548 | 549 | DATA: lt_fcat TYPE lvc_t_fcat. 550 | DATA: ls_fcat TYPE lvc_s_fcat. 551 | DATA: lt_event TYPE cntl_simple_events, 552 | ls_event TYPE cntl_simple_event. 553 | 554 | gr_reg_root = lcl_registry_entry=>get_root( ). 555 | 556 | * Create tree 557 | CREATE OBJECT gr_tree 558 | EXPORTING 559 | parent = gr_splitter->top_left_container 560 | node_selection_mode = cl_gui_column_tree=>node_sel_mode_single 561 | item_selection = abap_false 562 | no_toolbar = abap_false 563 | no_html_header = abap_true 564 | EXCEPTIONS 565 | cntl_error = 1 566 | cntl_system_error = 2 567 | create_error = 3 568 | lifetime_error = 4 569 | illegal_node_selection_mode = 5 570 | failed = 6 571 | illegal_column_name = 7 572 | OTHERS = 8. 573 | IF sy-subrc <> 0. 574 | MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno 575 | WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4. 576 | ENDIF. 577 | 578 | * Add key so that there is *something* in the field catalog 579 | ls_fcat-fieldname = 'KEY'. 580 | ls_fcat-no_out = abap_true. 581 | APPEND ls_fcat TO lt_fcat. 582 | 583 | CALL METHOD gr_tree->set_table_for_first_display 584 | CHANGING 585 | it_outtab = gt_tab 586 | it_fieldcatalog = lt_fcat. 587 | 588 | * Get handle on tree toolbar 589 | DATA: lt_ttb TYPE ttb_button. 590 | DATA: ls_ttb TYPE stb_button. 591 | gr_tree->get_toolbar_object( IMPORTING er_toolbar = gr_tree_toolbar ). 592 | gr_tree_toolbar->delete_all_buttons( ). 593 | * Add custom buttons for registry entry operations 594 | ls_ttb-function = 'INSE'. "Insert entry 595 | ls_ttb-icon = '@17@'. "ICON_INSERT_ROW 596 | APPEND ls_ttb TO lt_ttb. 597 | ls_ttb-function = 'DELE'. "Delete entry 598 | ls_ttb-icon = '@18@'. "ICON_DELETE_ROW 599 | APPEND ls_ttb TO lt_ttb. 600 | ls_ttb-function = 'COPY'. "Copy Entry 601 | ls_ttb-icon = '@14@'. "ICON_COPY_OBJECT 602 | APPEND ls_ttb TO lt_ttb. 603 | CALL METHOD gr_tree_toolbar->add_button_group 604 | EXPORTING 605 | data_table = lt_ttb 606 | EXCEPTIONS 607 | dp_error = 1 608 | cntb_error_fcode = 2 609 | OTHERS = 3. 610 | IF sy-subrc <> 0. 611 | MESSAGE 'Error when setting up registry toolbar'(005) TYPE 'E'. 612 | ENDIF. 613 | 614 | * Add root node 615 | PERFORM add_node USING '' gr_reg_root. 616 | 617 | * Register events and set handlers 618 | * ls_event-eventid = cl_gui_simple_tree=>eventid_node_double_click. 619 | ls_event-eventid = cl_gui_simple_tree=>eventid_selection_changed. 620 | ls_event-appl_event = 'X'. 621 | APPEND ls_event TO lt_event. 622 | ls_event-eventid = cl_gui_simple_tree=>eventid_expand_no_children. 623 | ls_event-appl_event = 'X'. 624 | APPEND ls_event TO lt_event. 625 | CALL METHOD gr_tree->set_registered_events 626 | EXPORTING 627 | events = lt_event 628 | EXCEPTIONS 629 | cntl_error = 1 630 | cntl_system_error = 2 631 | illegal_event_combination = 3. 632 | IF sy-subrc <> 0. 633 | MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno 634 | WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4. 635 | ENDIF. 636 | 637 | SET HANDLER event_handler=>handle_node_expand FOR gr_tree. 638 | SET HANDLER event_handler=>handle_node_selected FOR gr_tree. 639 | SET HANDLER event_handler=>handle_tree_command FOR gr_tree_toolbar. 640 | 641 | CALL METHOD gr_tree->frontend_update. 642 | 643 | ENDFORM. "create_tree 644 | 645 | *&---------------------------------------------------------------------* 646 | *& Form value_input_dialog 647 | *&---------------------------------------------------------------------* 648 | * Get single value from user 649 | *----------------------------------------------------------------------* 650 | FORM value_input_dialog USING title CHANGING value returncode. 651 | DATA: lt_fld TYPE TABLE OF sval. 652 | DATA: ls_fld TYPE sval. 653 | 654 | ls_fld-tabname = 'OJFIELDS'. 655 | ls_fld-fieldname = 'INPUT'. 656 | APPEND ls_fld TO lt_fld. 657 | 658 | CALL FUNCTION 'POPUP_GET_VALUES' 659 | EXPORTING 660 | no_value_check = abap_true 661 | popup_title = title 662 | IMPORTING 663 | returncode = returncode 664 | TABLES 665 | fields = lt_fld 666 | EXCEPTIONS 667 | error_in_fields = 1 668 | OTHERS = 2. 669 | IF sy-subrc <> 0. 670 | MESSAGE 'Error during request for value'(008) TYPE 'E'. 671 | ENDIF. 672 | 673 | READ TABLE lt_fld INTO ls_fld INDEX 1. 674 | value = ls_fld-value. 675 | 676 | ENDFORM. "value_input_dialog 677 | 678 | START-OF-SELECTION. 679 | 680 | 681 | AT SELECTION-SCREEN OUTPUT. 682 | * Disable Execute and Save functions on report selection screen 683 | PERFORM insert_into_excl(rsdbrunt) USING 'ONLI'. 684 | PERFORM insert_into_excl(rsdbrunt) USING 'SPOS'. 685 | 686 | * Initialize the display on the first dynpro roundtrip 687 | IF gr_splitter IS NOT BOUND. 688 | DATA: gv_dynnr TYPE sydynnr. 689 | DATA: gv_repid TYPE syrepid. 690 | gv_dynnr = sy-dynnr. 691 | gv_repid = sy-repid. 692 | CREATE OBJECT gr_splitter 693 | EXPORTING 694 | link_dynnr = gv_dynnr 695 | link_repid = gv_repid 696 | parent = cl_gui_easy_splitter_container=>default_screen 697 | orientation = 1 " Orientation: 0 = Vertical, 1 = Horizontal 698 | sash_position = 30 " Position of Splitter Bar (in Percent) 699 | with_border = 0 " With Border = 1; Without Border = 0 700 | EXCEPTIONS 701 | cntl_error = 1 702 | cntl_system_error = 2 703 | OTHERS = 3. 704 | 705 | IF sy-subrc <> 0. 706 | EXIT. 707 | ENDIF. 708 | 709 | PERFORM create_tree. 710 | 711 | * Table creation is deferred until the first node is selected 712 | 713 | ENDIF. 714 | -------------------------------------------------------------------------------- /src/yy_lib_turtle.prog.abap: -------------------------------------------------------------------------------- 1 | *&---------------------------------------------------------------------* 2 | *& Include YY_LIB_TURTLE 3 | *&---------------------------------------------------------------------* 4 | * Ported from https://github.com/FreHu/abap-turtle-graphics 5 | 6 | "TYPES tv_real TYPE decfloat34. " real data type 7 | 8 | CLASS lcx_turtle_problem DEFINITION CREATE PRIVATE 9 | INHERITING FROM cx_no_check. 10 | 11 | PUBLIC SECTION. 12 | CLASS-METHODS raise IMPORTING text TYPE string. 13 | METHODS constructor IMPORTING text TYPE string 14 | previous TYPE REF TO cx_root OPTIONAL. 15 | PRIVATE SECTION. 16 | DATA text TYPE string. 17 | ENDCLASS. 18 | 19 | CLASS lcx_turtle_problem IMPLEMENTATION. 20 | 21 | METHOD raise. 22 | RAISE EXCEPTION TYPE lcx_turtle_problem EXPORTING text = text. 23 | ENDMETHOD. 24 | 25 | METHOD constructor ##ADT_SUPPRESS_GENERATION. 26 | super->constructor( ). 27 | me->text = text. 28 | me->previous = previous. 29 | ENDMETHOD. 30 | ENDCLASS. 31 | 32 | CLASS lcl_turtle_math DEFINITION. 33 | PUBLIC SECTION. 34 | TYPES numbers_i TYPE STANDARD TABLE OF tv_int WITH DEFAULT KEY. 35 | 36 | CLASS-METHODS find_max_int 37 | IMPORTING numbers TYPE numbers_i 38 | RETURNING VALUE(result) TYPE tv_int. 39 | ENDCLASS. 40 | 41 | CLASS lcl_turtle_math IMPLEMENTATION. 42 | 43 | METHOD find_max_int. 44 | DATA(max) = numbers[ 1 ]. 45 | LOOP AT numbers ASSIGNING FIELD-SYMBOL() FROM 2. 46 | CHECK > max. 47 | max = . 48 | ENDLOOP. 49 | 50 | result = max. 51 | ENDMETHOD. 52 | ENDCLASS. 53 | 54 | CLASS lcl_turtle_convert DEFINITION. 55 | PUBLIC SECTION. 56 | CLASS-METHODS degrees_to_radians 57 | IMPORTING degrees TYPE tv_real 58 | RETURNING VALUE(radians) TYPE tv_real. 59 | 60 | CLASS-METHODS radians_to_degrees 61 | IMPORTING radians TYPE tv_real 62 | RETURNING VALUE(degrees) TYPE tv_real. 63 | ENDCLASS. 64 | 65 | CLASS lcl_turtle_convert IMPLEMENTATION. 66 | 67 | METHOD degrees_to_radians. 68 | radians = degrees * c_pi / 180. 69 | ENDMETHOD. 70 | 71 | METHOD radians_to_degrees. 72 | degrees = radians * 180 / c_pi. 73 | ENDMETHOD. 74 | ENDCLASS. 75 | 76 | CLASS lcl_number_range DEFINITION. 77 | PUBLIC SECTION. 78 | TYPES number_range TYPE STANDARD TABLE OF i WITH EMPTY KEY. 79 | 80 | "! Returns the list of numbers <min, max). 81 | "! This method repeats the mistake of Python 2.x and will consume a lot of memory if used with large ranges 82 | CLASS-METHODS get 83 | IMPORTING min TYPE i 84 | max TYPE i 85 | RETURNING VALUE(result) TYPE number_range. 86 | ENDCLASS. 87 | 88 | CLASS lcl_number_range IMPLEMENTATION. 89 | 90 | METHOD get. 91 | DATA(i) = min. 92 | WHILE i < max. 93 | APPEND i TO result. 94 | i = i + 1. 95 | ENDWHILE. 96 | ENDMETHOD. 97 | ENDCLASS. 98 | 99 | CLASS lcl_turtle_colors DEFINITION. 100 | PUBLIC SECTION. 101 | TYPES: rgb_hex_color TYPE string, 102 | rgb_hex_colors TYPE STANDARD TABLE OF rgb_hex_color WITH EMPTY KEY. 103 | 104 | TYPES: BEGIN OF t_pen, 105 | stroke_color TYPE rgb_hex_color, 106 | stroke_width TYPE i, 107 | fill_color TYPE rgb_hex_color, 108 | is_up TYPE abap_bool, 109 | END OF t_pen. 110 | 111 | CLASS-METHODS class_constructor. 112 | CLASS-METHODS get_random_color 113 | IMPORTING colors TYPE rgb_hex_colors 114 | RETURNING VALUE(color) TYPE rgb_hex_color. 115 | 116 | CLASS-DATA default_color_scheme TYPE rgb_hex_colors. 117 | CLASS-DATA default_pen TYPE t_pen. 118 | PROTECTED SECTION. 119 | PRIVATE SECTION. 120 | CLASS-DATA random TYPE REF TO cl_abap_random. 121 | ENDCLASS. 122 | 123 | 124 | CLASS lcl_turtle_colors IMPLEMENTATION. 125 | 126 | METHOD class_constructor. 127 | default_color_scheme = VALUE #( 128 | ( `#8a295c` ) 129 | ( `#5bbc6d` ) 130 | ( `#cb72d3` ) 131 | ( `#a8b03f` ) 132 | ( `#6973d8` ) 133 | ( `#c38138` ) 134 | ( `#543788` ) 135 | ( `#768a3c` ) 136 | ( `#ac4595` ) 137 | ( `#47bf9c` ) 138 | ( `#db6697` ) 139 | ( `#5f8dd3` ) 140 | ( `#b64e37` ) 141 | ( `#c287d1` ) 142 | ( `#ba4758` ) ). 143 | 144 | random = cl_abap_random=>create( seed = 42 ). 145 | 146 | default_pen = VALUE t_pen( stroke_width = 1 147 | stroke_color = `#FF0000` 148 | is_up = abap_false ). 149 | ENDMETHOD. 150 | 151 | METHOD get_random_color. 152 | DATA(random_index) = random->intinrange( low = 1 high = lines( colors ) ). 153 | color = colors[ random_index ]. 154 | ENDMETHOD. 155 | ENDCLASS. 156 | 157 | CLASS lcl_turtle DEFINITION DEFERRED. 158 | 159 | CLASS lcl_turtle_svg DEFINITION CREATE PRIVATE. 160 | PUBLIC SECTION. 161 | TYPES: 162 | BEGIN OF t_point, 163 | x TYPE i, 164 | y TYPE i, 165 | END OF t_point, 166 | t_points TYPE STANDARD TABLE OF t_point WITH DEFAULT KEY. 167 | 168 | TYPES: 169 | BEGIN OF line_params, 170 | x_from TYPE i, 171 | y_from TYPE i, 172 | x_to TYPE i, 173 | y_to TYPE i, 174 | END OF line_params, 175 | 176 | 177 | BEGIN OF polygon_params, 178 | points TYPE t_points, 179 | END OF polygon_params, 180 | polyline_params TYPE polygon_params, 181 | 182 | BEGIN OF text_params, 183 | x TYPE i, 184 | y TYPE i, 185 | text TYPE string, 186 | END OF text_params, 187 | 188 | BEGIN OF circle_params, 189 | center_x TYPE i, 190 | center_y TYPE i, 191 | radius TYPE i, 192 | END OF circle_params. 193 | 194 | CLASS-METHODS new IMPORTING turtle TYPE REF TO lcl_turtle 195 | RETURNING VALUE(result) TYPE REF TO lcl_turtle_svg. 196 | 197 | METHODS: line IMPORTING params TYPE line_params 198 | RETURNING VALUE(svg_line) TYPE string, 199 | 200 | polygon IMPORTING params TYPE polygon_params 201 | RETURNING VALUE(svg_polygon) TYPE string, 202 | 203 | polyline IMPORTING params TYPE polyline_params 204 | RETURNING VALUE(svg_polyline) TYPE string, 205 | 206 | text IMPORTING params TYPE text_params 207 | RETURNING VALUE(svg_text) TYPE string, 208 | 209 | circle IMPORTING params TYPE circle_params 210 | RETURNING VALUE(svg_circle) TYPE string. 211 | 212 | PROTECTED SECTION. 213 | DATA turtle TYPE REF TO lcl_turtle. 214 | 215 | METHODS constructor IMPORTING turtle TYPE REF TO lcl_turtle. 216 | ENDCLASS. 217 | 218 | CLASS lcl_turtle DEFINITION CREATE PRIVATE. 219 | PUBLIC SECTION. 220 | CONSTANTS: 221 | BEGIN OF defaults, 222 | height TYPE tv_int VALUE 800, 223 | width TYPE tv_int VALUE 600, 224 | title TYPE string VALUE `abapTurtle`, 225 | END OF defaults. 226 | 227 | TYPES: t_point TYPE lcl_turtle_svg=>t_point, 228 | t_points TYPE lcl_turtle_svg=>t_points. 229 | 230 | TYPES t_pen TYPE lcl_turtle_colors=>t_pen. 231 | TYPES rgb_hex_color TYPE lcl_turtle_colors=>rgb_hex_color. 232 | TYPES rgb_hex_colors TYPE lcl_turtle_colors=>rgb_hex_colors. 233 | 234 | TYPES: 235 | BEGIN OF turtle_position, 236 | x TYPE tv_int, 237 | y TYPE tv_int, 238 | angle TYPE tv_real, 239 | END OF turtle_position. 240 | 241 | TYPES multiple_turtles TYPE STANDARD TABLE OF REF TO lcl_turtle. 242 | 243 | CLASS-METHODS new 244 | IMPORTING height TYPE tv_int DEFAULT defaults-height 245 | width TYPE tv_int DEFAULT defaults-width 246 | background_color TYPE rgb_hex_color OPTIONAL 247 | title TYPE string DEFAULT defaults-title 248 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 249 | 250 | "! Creates a new turtle based on an existing instance. The position, angle and pen are preserved. 251 | "! Does not preserve content. 252 | METHODS clone RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 253 | 254 | "! Merges drawings of multiple turtles into one. 255 | CLASS-METHODS compose 256 | IMPORTING turtles TYPE multiple_turtles 257 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 258 | 259 | METHODS constructor 260 | IMPORTING height TYPE tv_int 261 | width TYPE tv_int 262 | background_color TYPE rgb_hex_color OPTIONAL 263 | title TYPE string. 264 | 265 | METHODS right 266 | IMPORTING degrees TYPE tv_real 267 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 268 | 269 | METHODS left IMPORTING degrees TYPE tv_real 270 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 271 | 272 | METHODS set_pen IMPORTING pen TYPE t_pen 273 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 274 | 275 | METHODS goto 276 | IMPORTING x TYPE tv_int 277 | y TYPE tv_int 278 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 279 | 280 | METHODS set_angle IMPORTING angle TYPE tv_real. 281 | 282 | METHODS forward IMPORTING how_far TYPE tv_int 283 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 284 | 285 | METHODS to_offset 286 | IMPORTING delta_x TYPE numeric 287 | delta_y TYPE numeric 288 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 289 | 290 | METHODS back IMPORTING how_far TYPE tv_int 291 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 292 | 293 | METHODS pen_up RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 294 | 295 | METHODS pen_down RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 296 | 297 | METHODS show 298 | IMPORTING size TYPE string DEFAULT cl_abap_browser=>xlarge 299 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 300 | 301 | METHODS polygon_flower IMPORTING number_of_polygons TYPE tv_int 302 | polygon_sides TYPE tv_int 303 | side_length TYPE tv_int 304 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 305 | 306 | METHODS filled_square IMPORTING side_length TYPE tv_int 307 | start TYPE t_point 308 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 309 | 310 | METHODS regular_polygon IMPORTING num_sides TYPE tv_int 311 | side_length TYPE tv_int 312 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 313 | 314 | METHODS download 315 | IMPORTING filename TYPE string DEFAULT `abap-turtle.html`. 316 | 317 | METHODS enable_random_colors. 318 | METHODS disable_random_colors. 319 | 320 | METHODS get_svg RETURNING VALUE(svg) TYPE string. 321 | METHODS append_svg IMPORTING svg_to_append TYPE string. 322 | 323 | METHODS: 324 | get_position RETURNING VALUE(result) TYPE turtle_position, 325 | set_position IMPORTING position TYPE turtle_position, 326 | set_color_scheme IMPORTING color_scheme TYPE rgb_hex_colors, 327 | set_width IMPORTING width TYPE tv_int, 328 | set_height IMPORTING height TYPE tv_int, 329 | set_svg IMPORTING svg TYPE string. 330 | 331 | DATA: title TYPE string READ-ONLY, 332 | svg TYPE string READ-ONLY, 333 | width TYPE tv_int READ-ONLY, 334 | height TYPE tv_int READ-ONLY, 335 | position TYPE turtle_position READ-ONLY, 336 | pen TYPE t_pen READ-ONLY, 337 | color_scheme TYPE rgb_hex_colors READ-ONLY, 338 | svg_builder TYPE REF TO lcl_turtle_svg READ-ONLY. 339 | 340 | PROTECTED SECTION. 341 | PRIVATE SECTION. 342 | DATA use_random_colors TYPE abap_bool. 343 | 344 | METHODS get_html RETURNING VALUE(html) TYPE string. 345 | 346 | METHODS line 347 | IMPORTING x_from TYPE tv_int 348 | y_from TYPE tv_int 349 | x_to TYPE tv_int 350 | y_to TYPE tv_int 351 | RETURNING VALUE(turtle) TYPE REF TO lcl_turtle. 352 | ENDCLASS. 353 | 354 | CLASS lcl_turtle IMPLEMENTATION. 355 | 356 | METHOD back. 357 | right( degrees = 180 ). 358 | forward( how_far ). 359 | right( degrees = 180 ). 360 | ENDMETHOD. 361 | 362 | METHOD constructor. 363 | me->width = width. 364 | me->height = height. 365 | me->pen = lcl_turtle_colors=>default_pen. 366 | me->color_scheme = lcl_turtle_colors=>default_color_scheme. 367 | me->use_random_colors = abap_true. 368 | me->title = title. 369 | me->svg_builder = lcl_turtle_svg=>new( me ). 370 | 371 | IF background_color IS NOT INITIAL. 372 | me->set_pen( VALUE #( fill_color = background_color ) ). 373 | DATA(side_length) = 100. 374 | 375 | DATA(points) = VALUE t_points( ( x = 0 y = 0 ) 376 | ( x = 0 + width y = 0 ) 377 | ( x = 0 + width y = 0 + height ) 378 | ( x = 0 y = 0 + height ) ). 379 | 380 | me->append_svg( me->svg_builder->polyline( VALUE #( points = points ) ) ). 381 | ENDIF. 382 | 383 | me->pen = VALUE #( stroke_width = 1 384 | stroke_color = `#FF0000` 385 | is_up = abap_false ). 386 | ENDMETHOD. 387 | 388 | METHOD disable_random_colors. 389 | me->use_random_colors = abap_false. 390 | ENDMETHOD. 391 | 392 | METHOD download. 393 | 394 | DATA(file_name) = filename. 395 | DATA(path) = ``. 396 | DATA(full_path) = ``. 397 | 398 | cl_gui_frontend_services=>file_save_dialog( 399 | EXPORTING 400 | default_extension = `html` 401 | default_file_name = filename 402 | initial_directory = `` 403 | CHANGING 404 | filename = file_name 405 | path = path 406 | fullpath = full_path 407 | EXCEPTIONS 408 | OTHERS = 1 ). 409 | 410 | IF sy-subrc <> 0. 411 | MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno 412 | WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4. 413 | ENDIF. 414 | 415 | SPLIT me->get_html( ) AT |\r\n| INTO TABLE DATA(lines). 416 | cl_gui_frontend_services=>gui_download( 417 | EXPORTING 418 | filename = file_name 419 | CHANGING 420 | data_tab = lines 421 | EXCEPTIONS OTHERS = 1 ). 422 | 423 | IF sy-subrc <> 0. 424 | MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno 425 | WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4. 426 | ENDIF. 427 | 428 | ENDMETHOD. 429 | 430 | METHOD enable_random_colors. 431 | me->use_random_colors = abap_true. 432 | ENDMETHOD. 433 | 434 | METHOD to_offset. 435 | DATA(old_position) = position. 436 | DATA(new_position) = VALUE turtle_position( x = round( val = old_position-x + delta_x dec = 0 ) 437 | y = round( val = old_position-y + delta_y dec = 0 ) 438 | angle = old_position-angle ). 439 | IF pen-is_up = abap_false. 440 | me->line( x_from = position-x 441 | y_from = position-y 442 | x_to = new_position-x 443 | y_to = new_position-y ). 444 | ENDIF. 445 | 446 | set_position( new_position ). 447 | 448 | turtle = me. 449 | ENDMETHOD. 450 | 451 | METHOD forward. 452 | DATA(angle) = CONV f( lcl_turtle_convert=>degrees_to_radians( position-angle ) ). 453 | 454 | turtle = to_offset( delta_x = how_far * cos( angle ) 455 | delta_y = how_far * sin( angle ) ). 456 | ENDMETHOD. 457 | 458 | METHOD get_html. 459 | html = |

abapTurtle

{ svg }|. 460 | ENDMETHOD. 461 | 462 | METHOD get_position. 463 | result = me->position. 464 | ENDMETHOD. 465 | 466 | METHOD get_svg. 467 | svg = me->svg. 468 | ENDMETHOD. 469 | 470 | METHOD append_svg. 471 | svg = svg && svg_to_append. 472 | ENDMETHOD. 473 | 474 | METHOD goto. 475 | position-x = x. 476 | position-y = y. 477 | turtle = me. 478 | ENDMETHOD. 479 | 480 | METHOD left. 481 | position-angle = position-angle - degrees. 482 | position-angle = position-angle MOD 360. 483 | turtle = me. 484 | ENDMETHOD. 485 | 486 | METHOD line. 487 | 488 | IF use_random_colors = abap_true. 489 | pen-stroke_color = lcl_turtle_colors=>get_random_color( me->color_scheme ). 490 | ENDIF. 491 | 492 | svg = svg && ||. 494 | 495 | turtle = me. 496 | ENDMETHOD. 497 | 498 | METHOD new. 499 | turtle = NEW lcl_turtle( width = width 500 | height = height 501 | background_color = background_color 502 | title = title ). 503 | ENDMETHOD. 504 | 505 | METHOD clone. 506 | turtle = NEW #( width = width 507 | height = height 508 | title = title ). 509 | 510 | turtle->set_pen( pen ). 511 | turtle->set_color_scheme( color_scheme ). 512 | turtle->set_position( position ). 513 | turtle->set_angle( position-angle ). 514 | ENDMETHOD. 515 | 516 | METHOD compose. 517 | 518 | IF lines( turtles ) < 1. 519 | lcx_turtle_problem=>raise( `Not enough turtles to compose anything.` ). 520 | ENDIF. 521 | 522 | " start where the last one left off 523 | DATA(lo_turtle) = turtles[ lines( turtles ) ]. 524 | turtle = lo_turtle->clone( ). 525 | 526 | " new image size is the largest of composed turtles 527 | DATA(new_width) = lcl_turtle_math=>find_max_int( 528 | VALUE #( FOR IN turtles ( ->width ) ) ). 529 | 530 | DATA(new_height) = lcl_turtle_math=>find_max_int( 531 | VALUE #( FOR IN turtles ( ->height ) ) ). 532 | 533 | turtle->set_height( new_height ). 534 | turtle->set_width( new_width ). 535 | 536 | DATA(composed_svg) = REDUCE string( INIT result = `` 537 | FOR IN VALUE stringtab( FOR IN turtles ( ->svg ) ) 538 | NEXT result = result && ). 539 | 540 | turtle->append_svg( composed_svg ). 541 | 542 | ENDMETHOD. 543 | 544 | METHOD pen_down. 545 | me->pen-is_up = abap_false. 546 | turtle = me. 547 | ENDMETHOD. 548 | 549 | METHOD pen_up. 550 | me->pen-is_up = abap_true. 551 | turtle = me. 552 | ENDMETHOD. 553 | 554 | METHOD right. 555 | position-angle = position-angle + degrees. 556 | position-angle = position-angle MOD 360. 557 | turtle = me. 558 | ENDMETHOD. 559 | 560 | METHOD set_angle. 561 | me->position-angle = angle. 562 | ENDMETHOD. 563 | 564 | METHOD set_color_scheme. 565 | me->color_scheme = color_scheme. 566 | ENDMETHOD. 567 | 568 | METHOD set_width. 569 | me->width = width. 570 | ENDMETHOD. 571 | 572 | METHOD set_height. 573 | me->height = height. 574 | ENDMETHOD. 575 | 576 | METHOD set_svg. 577 | me->svg = svg. 578 | ENDMETHOD. 579 | 580 | METHOD set_pen. 581 | me->pen = pen. 582 | turtle = me. 583 | ENDMETHOD. 584 | 585 | METHOD set_position. 586 | me->position = position. 587 | ENDMETHOD. 588 | 589 | METHOD show. 590 | cl_abap_browser=>show_html( size = size 591 | html_string = get_html( ) ). 592 | turtle = me. 593 | ENDMETHOD. 594 | 595 | METHOD regular_polygon. 596 | DATA(angle) = CONV tv_real( 360 / num_sides ). 597 | DATA(n) = nmax( val1 = 0 val2 = num_sides ). 598 | DO n TIMES. 599 | forward( side_length ). 600 | right( angle ). 601 | ENDDO. 602 | 603 | turtle = me. 604 | ENDMETHOD. 605 | 606 | METHOD polygon_flower. 607 | DATA(current_polygon) = 0. 608 | WHILE current_polygon < number_of_polygons. 609 | 610 | regular_polygon( num_sides = polygon_sides 611 | side_length = side_length ). 612 | 613 | " rotate before painting next polygon 614 | right( 360 / number_of_polygons ). 615 | 616 | current_polygon = current_polygon + 1. 617 | ENDWHILE. 618 | 619 | turtle = me. 620 | ENDMETHOD. 621 | 622 | METHOD filled_square. 623 | DATA(points) = VALUE t_points( ( start ) 624 | ( x = start-x + side_length y = start-y ) 625 | ( x = start-x + side_length y = start-y + side_length ) 626 | ( x = start-x y = start-y + side_length ) ). 627 | 628 | append_svg( svg_builder->polyline( VALUE #( points = points ) ) ). 629 | 630 | turtle = me. 631 | ENDMETHOD. 632 | 633 | ENDCLASS. 634 | 635 | CLASS lcl_turtle_lsystem DEFINITION. 636 | 637 | PUBLIC SECTION. 638 | TYPES: 639 | BEGIN OF lsystem_rewrite_rule, 640 | from TYPE string, 641 | to TYPE string, 642 | END OF lsystem_rewrite_rule, 643 | lsystem_rewrite_rules TYPE STANDARD TABLE OF lsystem_rewrite_rule WITH DEFAULT KEY. 644 | 645 | TYPES lsystem_instruction_kind TYPE string. 646 | 647 | CONSTANTS: 648 | BEGIN OF instruction_kind, 649 | "! Doesn't do anything. Can be used for helper symbols. 650 | noop TYPE lsystem_instruction_kind VALUE `noop`, 651 | "! Go forward by 'amount' pixels 652 | forward TYPE lsystem_instruction_kind VALUE `forwrad`, 653 | "! Go back by 'amount' pixels 654 | back TYPE lsystem_instruction_kind VALUE `back`, 655 | "! Turn left by 'amount' degrees 656 | left TYPE lsystem_instruction_kind VALUE `left`, 657 | "! Turn right by 'amount' degrees 658 | right TYPE lsystem_instruction_kind VALUE `right`, 659 | "! Push position on the stack 660 | stack_push TYPE lsystem_instruction_kind VALUE `stack_push`, 661 | "! Pop position from the stack 662 | stack_pop TYPE lsystem_instruction_kind VALUE `stack_pop`, 663 | END OF instruction_kind. 664 | 665 | TYPES: 666 | BEGIN OF lsystem_instruction, 667 | symbol TYPE char01, 668 | kind TYPE lsystem_instruction_kind, 669 | "! Distance or angle (if the operation requires it) 670 | amount TYPE tv_int, 671 | * move_distance TYPE tv_int, "! For move instructions, how many pixels to move by 672 | * rotate_by TYPE tv_real, "! For rotate instructions, how many degrees to rotate by 673 | END OF lsystem_instruction, 674 | lsystem_instructions TYPE HASHED TABLE OF lsystem_instruction WITH UNIQUE KEY symbol. 675 | 676 | TYPES: 677 | BEGIN OF params, 678 | "! Starting symbols 679 | initial_state TYPE string, 680 | "! How many times the rewrite rules will be applied 681 | num_iterations TYPE i, 682 | instructions TYPE lsystem_instructions, 683 | "! A list of rewrite patterns which will be applied each iteration in order. 684 | "! E.g. initial state F with rule F -> FG and 3 iterations 685 | "! will produce FG, FGG, FGGG in each iteration respectively. 686 | "! Currently allows up to 3 variables F,G,H 687 | rewrite_rules TYPE lsystem_rewrite_rules, 688 | END OF params. 689 | 690 | CLASS-METHODS new 691 | IMPORTING turtle TYPE REF TO lcl_turtle 692 | parameters TYPE params 693 | RETURNING VALUE(result) TYPE REF TO lcl_turtle_lsystem. 694 | 695 | CLASS-METHODS koch_curve_params RETURNING VALUE(params) TYPE params. 696 | CLASS-METHODS pattern_params RETURNING VALUE(params) TYPE params. 697 | CLASS-METHODS plant_params RETURNING VALUE(params) TYPE params. 698 | CLASS-METHODS plant_2_params RETURNING VALUE(params) TYPE params. 699 | 700 | METHODS execute. 701 | METHODS show IMPORTING size TYPE string DEFAULT cl_abap_browser=>large. 702 | 703 | PROTECTED SECTION. 704 | PRIVATE SECTION. 705 | METHODS get_final_value 706 | RETURNING VALUE(result) TYPE string. 707 | 708 | TYPES t_position_stack TYPE STANDARD TABLE OF lcl_turtle=>turtle_position WITH EMPTY KEY. 709 | METHODS: 710 | push_stack IMPORTING position TYPE lcl_turtle=>turtle_position, 711 | pop_stack RETURNING VALUE(position) TYPE lcl_turtle=>turtle_position. 712 | 713 | DATA turtle TYPE REF TO lcl_turtle. 714 | DATA parameters TYPE params. 715 | DATA position_stack TYPE t_position_stack. 716 | ENDCLASS. 717 | 718 | CLASS lcl_turtle_lsystem IMPLEMENTATION. 719 | 720 | METHOD execute. 721 | DATA(final_value) = get_final_value( ). 722 | 723 | DATA(index) = 0. 724 | WHILE index < strlen( final_value ). 725 | DATA(symbol) = final_value+index(1). " char 726 | DATA(rule) = VALUE #( parameters-instructions[ symbol = symbol ] OPTIONAL ). 727 | CASE rule-kind. 728 | WHEN instruction_kind-noop. 729 | CONTINUE. 730 | WHEN instruction_kind-forward. " WHEN `F` OR `G` OR `H`. 731 | turtle->forward( rule-amount ). " turtle->forward( parameters-move_distance ). 732 | WHEN instruction_kind-back. 733 | turtle->back( rule-amount ). 734 | WHEN instruction_kind-left. " WHEN `+`. 735 | turtle->right( CONV tv_real( rule-amount ) ). " turtle->right( parameters-rotate_by ). 736 | WHEN instruction_kind-right. " WHEN `-`. 737 | turtle->left( CONV tv_real( rule-amount ) ). " turtle->left( parameters-rotate_by ). 738 | WHEN instruction_kind-stack_push. " WHEN `[`. 739 | push_stack( turtle->position ). " push_stack( turtle->position ). 740 | WHEN instruction_kind-stack_pop. " WHEN `]`. 741 | DATA(position) = pop_stack( ). 742 | turtle->goto( x = position-x y = position-y ). 743 | turtle->set_angle( position-angle ). 744 | WHEN OTHERS. 745 | lcx_turtle_problem=>raise( |Lsystem - unconfigured symbol { symbol }.| ). 746 | ENDCASE. 747 | 748 | index = index + 1. 749 | ENDWHILE. 750 | 751 | ENDMETHOD. 752 | 753 | METHOD get_final_value. 754 | DATA(instructions) = parameters-initial_state. 755 | DO parameters-num_iterations TIMES. 756 | LOOP AT parameters-rewrite_rules ASSIGNING FIELD-SYMBOL(). 757 | REPLACE ALL OCCURRENCES OF -from IN instructions WITH -to. 758 | ENDLOOP. 759 | ENDDO. 760 | 761 | result = instructions. 762 | ENDMETHOD. 763 | 764 | METHOD new. 765 | result = NEW #( ). 766 | result->turtle = turtle. 767 | result->parameters = parameters. 768 | ENDMETHOD. 769 | 770 | METHOD pop_stack. 771 | position = position_stack[ lines( position_stack ) ]. 772 | DELETE position_stack INDEX lines( position_stack ). 773 | ENDMETHOD. 774 | 775 | METHOD push_stack. 776 | APPEND position TO position_stack. 777 | ENDMETHOD. 778 | 779 | METHOD show. 780 | turtle->show( size ). 781 | ENDMETHOD. 782 | 783 | METHOD koch_curve_params. 784 | params = VALUE #( 785 | initial_state = `F` 786 | " Move distance 10, Rotate right by 90, Rotate left by 90 787 | instructions = VALUE #( 788 | ( symbol = 'F' kind = instruction_kind-forward amount = 10 ) 789 | ( symbol = '+' kind = instruction_kind-right amount = 90 ) 790 | ( symbol = '-' kind = instruction_kind-left amount = 90 ) ) 791 | num_iterations = 3 792 | rewrite_rules = VALUE #( ( from = `F` to = `F+F-F-F+F` ) ) ). 793 | 794 | ENDMETHOD. 795 | 796 | METHOD pattern_params. 797 | params = VALUE #( initial_state = `F-F-F-F` 798 | instructions = VALUE #( 799 | ( symbol = 'F' kind = instruction_kind-forward amount = 10 ) 800 | ( symbol = '+' kind = instruction_kind-right amount = 90 ) 801 | ( symbol = '-' kind = instruction_kind-left amount = 90 ) ) 802 | num_iterations = 3 803 | rewrite_rules = VALUE #( ( from = `F` to = `FF-F+F-F-FF` ) ) ). 804 | ENDMETHOD. 805 | 806 | METHOD plant_params. 807 | params = VALUE #( LET distance = 10 rotation = 25 IN 808 | initial_state = `F` 809 | instructions = VALUE #( 810 | ( symbol = `F` kind = instruction_kind-forward amount = distance ) 811 | ( symbol = `+` kind = instruction_kind-right amount = rotation ) 812 | ( symbol = `-` kind = instruction_kind-left amount = rotation ) 813 | ( symbol = `[` kind = instruction_kind-stack_push ) 814 | ( symbol = `]` kind = instruction_kind-stack_pop ) ) 815 | num_iterations = 5 816 | rewrite_rules = VALUE #( ( from = `F` to = `F[+F]F[-F][F]` ) ) ). 817 | ENDMETHOD. 818 | 819 | METHOD plant_2_params. 820 | params = VALUE #( initial_state = `F` 821 | instructions = VALUE #( 822 | ( symbol = `F` kind = instruction_kind-forward amount = 10 ) 823 | ( symbol = `+` kind = instruction_kind-right amount = 21 ) 824 | ( symbol = `-` kind = instruction_kind-left amount = 21 ) 825 | ( symbol = `[` kind = instruction_kind-stack_push ) 826 | ( symbol = `]` kind = instruction_kind-stack_pop ) ) 827 | num_iterations = 4 828 | rewrite_rules = VALUE #( ( from = `F` to = `FF-[+F+F+F]+[-F-F+F]` ) ) ). 829 | ENDMETHOD. 830 | 831 | 832 | ENDCLASS. 833 | 834 | CLASS lcl_turtle_svg IMPLEMENTATION. 835 | 836 | METHOD circle. 837 | svg_circle = ||. 840 | ENDMETHOD. 841 | 842 | METHOD line. 843 | svg_line = ||. 845 | ENDMETHOD. 846 | 847 | METHOD constructor. 848 | me->turtle = turtle. 849 | ENDMETHOD. 850 | 851 | METHOD new. 852 | result = NEW #( turtle ). 853 | ENDMETHOD. 854 | 855 | METHOD polygon. 856 | DATA(point_data) = REDUCE string( 857 | INIT res = `` 858 | FOR point IN params-points 859 | NEXT res = res && |{ point-x },{ point-y } | ). 860 | 861 | svg_polygon = ||. 864 | ENDMETHOD. 865 | 866 | METHOD polyline. 867 | DATA(point_data) = REDUCE string( 868 | INIT res = `` 869 | FOR point IN params-points 870 | NEXT res = res && |{ point-x },{ point-y } | ). 871 | 872 | svg_polyline = ||. 875 | ENDMETHOD. 876 | 877 | METHOD text. 878 | svg_text = |{ params-text }|. 879 | ENDMETHOD. 880 | ENDCLASS. 881 | -------------------------------------------------------------------------------- /src/zcl_lisp_area.clas.abap: -------------------------------------------------------------------------------- 1 | class ZCL_LISP_AREA definition 2 | public 3 | inheriting from CL_SHM_AREA 4 | final 5 | create private 6 | 7 | global friends CL_SHM_AREA . 8 | 9 | public section. 10 | 11 | constants AREA_NAME type SHM_AREA_NAME value 'ZCL_LISP_AREA' ##NO_TEXT. 12 | data ROOT type ref to ZCL_LISP_SHM_ROOT read-only . 13 | 14 | class-methods CLASS_CONSTRUCTOR . 15 | class-methods GET_GENERATOR_VERSION 16 | returning 17 | value(GENERATOR_VERSION) type I . 18 | class-methods ATTACH_FOR_READ 19 | importing 20 | !INST_NAME type SHM_INST_NAME default CL_SHM_AREA=>DEFAULT_INSTANCE 21 | preferred parameter INST_NAME 22 | returning 23 | value(HANDLE) type ref to ZCL_LISP_AREA 24 | raising 25 | CX_SHM_INCONSISTENT 26 | CX_SHM_NO_ACTIVE_VERSION 27 | CX_SHM_READ_LOCK_ACTIVE 28 | CX_SHM_EXCLUSIVE_LOCK_ACTIVE 29 | CX_SHM_PARAMETER_ERROR 30 | CX_SHM_CHANGE_LOCK_ACTIVE . 31 | class-methods ATTACH_FOR_WRITE 32 | importing 33 | !INST_NAME type SHM_INST_NAME default CL_SHM_AREA=>DEFAULT_INSTANCE 34 | !ATTACH_MODE type SHM_ATTACH_MODE default CL_SHM_AREA=>ATTACH_MODE_DEFAULT 35 | !WAIT_TIME type I default 0 36 | preferred parameter INST_NAME 37 | returning 38 | value(HANDLE) type ref to ZCL_LISP_AREA 39 | raising 40 | CX_SHM_EXCLUSIVE_LOCK_ACTIVE 41 | CX_SHM_VERSION_LIMIT_EXCEEDED 42 | CX_SHM_CHANGE_LOCK_ACTIVE 43 | CX_SHM_PARAMETER_ERROR 44 | CX_SHM_PENDING_LOCK_REMOVED . 45 | class-methods ATTACH_FOR_UPDATE 46 | importing 47 | !INST_NAME type SHM_INST_NAME default CL_SHM_AREA=>DEFAULT_INSTANCE 48 | !ATTACH_MODE type SHM_ATTACH_MODE default CL_SHM_AREA=>ATTACH_MODE_DEFAULT 49 | !WAIT_TIME type I default 0 50 | preferred parameter INST_NAME 51 | returning 52 | value(HANDLE) type ref to ZCL_LISP_AREA 53 | raising 54 | CX_SHM_INCONSISTENT 55 | CX_SHM_NO_ACTIVE_VERSION 56 | CX_SHM_EXCLUSIVE_LOCK_ACTIVE 57 | CX_SHM_VERSION_LIMIT_EXCEEDED 58 | CX_SHM_CHANGE_LOCK_ACTIVE 59 | CX_SHM_PARAMETER_ERROR 60 | CX_SHM_PENDING_LOCK_REMOVED . 61 | class-methods DETACH_AREA 62 | returning 63 | value(RC) type SHM_RC . 64 | class-methods INVALIDATE_INSTANCE 65 | importing 66 | !INST_NAME type SHM_INST_NAME default CL_SHM_AREA=>DEFAULT_INSTANCE 67 | !TERMINATE_CHANGER type ABAP_BOOL default ABAP_TRUE 68 | !AFFECT_SERVER type SHM_AFFECT_SERVER default CL_SHM_AREA=>AFFECT_LOCAL_SERVER 69 | preferred parameter INST_NAME 70 | returning 71 | value(RC) type SHM_RC 72 | raising 73 | CX_SHM_PARAMETER_ERROR . 74 | class-methods INVALIDATE_AREA 75 | importing 76 | !TERMINATE_CHANGER type ABAP_BOOL default ABAP_TRUE 77 | !AFFECT_SERVER type SHM_AFFECT_SERVER default CL_SHM_AREA=>AFFECT_LOCAL_SERVER 78 | returning 79 | value(RC) type SHM_RC 80 | raising 81 | CX_SHM_PARAMETER_ERROR . 82 | class-methods FREE_INSTANCE 83 | importing 84 | !INST_NAME type SHM_INST_NAME default CL_SHM_AREA=>DEFAULT_INSTANCE 85 | !TERMINATE_CHANGER type ABAP_BOOL default ABAP_TRUE 86 | !AFFECT_SERVER type SHM_AFFECT_SERVER default CL_SHM_AREA=>AFFECT_LOCAL_SERVER 87 | preferred parameter INST_NAME 88 | returning 89 | value(RC) type SHM_RC 90 | raising 91 | CX_SHM_PARAMETER_ERROR . 92 | class-methods FREE_AREA 93 | importing 94 | !TERMINATE_CHANGER type ABAP_BOOL default ABAP_TRUE 95 | !AFFECT_SERVER type SHM_AFFECT_SERVER default CL_SHM_AREA=>AFFECT_LOCAL_SERVER 96 | returning 97 | value(RC) type SHM_RC 98 | raising 99 | CX_SHM_PARAMETER_ERROR . 100 | class-methods GET_INSTANCE_INFOS 101 | importing 102 | !INST_NAME type SHM_INST_NAME optional 103 | returning 104 | value(INFOS) type SHM_INST_INFOS . 105 | class-methods BUILD 106 | importing 107 | !INST_NAME type SHM_INST_NAME default CL_SHM_AREA=>DEFAULT_INSTANCE 108 | raising 109 | CX_SHMA_NOT_CONFIGURED 110 | CX_SHMA_INCONSISTENT 111 | CX_SHM_BUILD_FAILED . 112 | methods SET_ROOT 113 | importing 114 | !ROOT type ref to ZCL_LISP_SHM_ROOT 115 | raising 116 | CX_SHM_INITIAL_REFERENCE 117 | CX_SHM_WRONG_HANDLE . 118 | 119 | methods GET_ROOT 120 | redefinition . 121 | protected section. 122 | private section. 123 | 124 | constants _VERSION_ type I value 25 ##NO_TEXT. 125 | class-data _TRACE_SERVICE type ref to IF_SHM_TRACE . 126 | class-data _TRACE_ACTIVE type ABAP_BOOL value ABAP_FALSE ##NO_TEXT. 127 | constants _TRANSACTIONAL type ABAP_BOOL value ABAP_FALSE ##NO_TEXT. 128 | constants _CLIENT_DEPENDENT type ABAP_BOOL value ABAP_FALSE ##NO_TEXT. 129 | constants _LIFE_CONTEXT type SHM_LIFE_CONTEXT value CL_SHM_AREA=>LIFE_CONTEXT_APPSERVER ##NO_TEXT. 130 | ENDCLASS. 131 | 132 | 133 | 134 | CLASS ZCL_LISP_AREA IMPLEMENTATION. 135 | 136 | 137 | method ATTACH_FOR_READ. 138 | 139 | DATA: 140 | l_attributes TYPE shma_attributes, 141 | l_root TYPE REF TO object, 142 | l_cx TYPE REF TO cx_root, 143 | l_client TYPE shm_client, 144 | l_client_supplied TYPE abap_bool. "#EC NEEDED 145 | 146 | * check if tracing should be activated/de-activated 147 | IF ( NOT _trace_service IS INITIAL ). 148 | TRY. 149 | _trace_active = 150 | cl_shm_service=>trace_is_variant_active( 151 | _trace_service->variant-def_name 152 | ). 153 | CATCH cx_root. "#EC NO_HANDLER 154 | "#EC CATCH_ALL 155 | ENDTRY. 156 | ENDIF. 157 | 158 | 159 | IF _trace_active = abap_false OR 160 | _trace_service->variant-attach_for_read = abap_false. 161 | 162 | * > 163 | 164 | CREATE OBJECT handle. 165 | 166 | handle->client = l_client. 167 | handle->inst_name = inst_name. 168 | 169 | * try sneak mode first 170 | handle->_attach_read71( EXPORTING area_name = area_name 171 | sneak_mode = abap_true 172 | life_context = _life_context 173 | IMPORTING root = l_root ). 174 | 175 | IF l_root IS INITIAL. 176 | * no root object returned, sneak mode was not successful. 177 | * -> read area properties from database and try again. 178 | cl_shm_service=>initialize( 179 | EXPORTING area_name = handle->area_name 180 | client = l_client 181 | IMPORTING attributes = l_attributes 182 | ). 183 | 184 | handle->properties = l_attributes-properties. 185 | handle->_attach_read71( EXPORTING area_name = area_name 186 | sneak_mode = abap_false 187 | life_context = _life_context 188 | IMPORTING root = l_root ). 189 | 190 | ENDIF. 191 | 192 | handle->root ?= l_root. 193 | * < 194 | 195 | ELSE. 196 | 197 | TRY. 198 | 199 | * > 200 | 201 | CREATE OBJECT handle. 202 | 203 | handle->client = l_client. 204 | handle->inst_name = inst_name. 205 | 206 | handle->_attach_read71( EXPORTING area_name = area_name 207 | sneak_mode = abap_true 208 | life_context = _life_context 209 | IMPORTING root = l_root ). 210 | 211 | IF l_root IS INITIAL. 212 | * no root object returned, sneak mode was not successful. 213 | * -> read area properties from database and try again. 214 | cl_shm_service=>initialize( 215 | EXPORTING area_name = handle->area_name 216 | client = l_client 217 | IMPORTING attributes = l_attributes 218 | ). 219 | 220 | handle->properties = l_attributes-properties. 221 | handle->_attach_read71( EXPORTING area_name = area_name 222 | sneak_mode = abap_false 223 | life_context = _life_context 224 | IMPORTING root = l_root ). 225 | 226 | ENDIF. 227 | handle->root ?= l_root. 228 | 229 | * < 230 | _trace_service->trin_attach_for_read( 231 | area_name = area_name 232 | inst_name = inst_name 233 | client = l_client ). 234 | 235 | CLEANUP INTO l_cx. 236 | _trace_service->trcx_attach_for_read( 237 | area_name = area_name 238 | inst_name = inst_name 239 | client = l_client 240 | cx = l_cx 241 | ). 242 | ENDTRY. 243 | 244 | ENDIF. 245 | 246 | handle->inst_trace_service = _trace_service. 247 | handle->inst_trace_active = _trace_active. 248 | 249 | endmethod. 250 | 251 | 252 | method ATTACH_FOR_UPDATE. 253 | 254 | DATA: 255 | l_attributes TYPE shma_attributes, 256 | l_root TYPE REF TO object, 257 | l_cx TYPE REF TO cx_root, 258 | l_client TYPE shm_client, 259 | l_client_supplied TYPE abap_bool, "#EC NEEDED 260 | l_wait_time TYPE i, 261 | l_wait_time_per_loop TYPE i, 262 | l_wait_time_per_loop_sec TYPE f. 263 | 264 | l_wait_time = wait_time. 265 | 266 | * check if tracing should be activated/de-activated 267 | IF ( NOT _trace_service IS INITIAL ). 268 | TRY. 269 | _trace_active = 270 | cl_shm_service=>trace_is_variant_active( 271 | _trace_service->variant-def_name 272 | ). 273 | CATCH cx_root. "#EC NO_HANDLER 274 | "#EC CATCH_ALL 275 | ENDTRY. 276 | ENDIF. 277 | 278 | 279 | IF _trace_active = abap_false OR 280 | _trace_service->variant-attach_for_upd = abap_false. 281 | 282 | * > 283 | 284 | CREATE OBJECT handle. 285 | 286 | handle->client = l_client. 287 | handle->inst_name = inst_name. 288 | 289 | cl_shm_service=>initialize( 290 | EXPORTING area_name = handle->area_name 291 | client = l_client 292 | IMPORTING attributes = l_attributes 293 | ). 294 | 295 | handle->properties = l_attributes-properties. 296 | 297 | handle->_attach_update70( 298 | EXPORTING area_name = handle->area_name 299 | mode = attach_mode 300 | IMPORTING root = l_root 301 | CHANGING wait_time = l_wait_time ). 302 | 303 | IF abap_true = l_attributes-properties-has_versions AND 304 | handle->_lock IS NOT INITIAL. 305 | * we may need a second try in case of class constructors 306 | handle->_attach_update70( 307 | EXPORTING area_name = handle->area_name 308 | mode = attach_mode 309 | IMPORTING root = l_root 310 | CHANGING wait_time = l_wait_time ). 311 | ENDIF. 312 | 313 | IF attach_mode = cl_shm_area=>attach_mode_wait AND 314 | handle->_lock IS INITIAL. 315 | 316 | l_wait_time_per_loop = l_wait_time / 10. 317 | * wait_time_per_loop should be at least 2 * SHMATTACHWRITE_MAXACTIVEWAIT 318 | IF l_wait_time_per_loop < 2000. 319 | l_wait_time_per_loop = 2000. 320 | ELSEIF l_wait_time_per_loop > 300000. 321 | l_wait_time_per_loop = 300000. 322 | ENDIF. 323 | 324 | l_wait_time_per_loop_sec = l_wait_time_per_loop / 1000. 325 | 326 | WHILE handle->_lock IS INITIAL. 327 | 328 | IF l_wait_time_per_loop > l_wait_time. 329 | l_wait_time_per_loop = l_wait_time. 330 | l_wait_time_per_loop_sec = l_wait_time_per_loop / 1000. 331 | ENDIF. 332 | 333 | WAIT UP TO l_wait_time_per_loop_sec SECONDS. 334 | l_wait_time = l_wait_time - l_wait_time_per_loop. 335 | 336 | handle->_attach_update70( 337 | EXPORTING area_name = handle->area_name 338 | mode = cl_shm_area=>attach_mode_wait_2nd_try 339 | IMPORTING root = l_root 340 | CHANGING wait_time = l_wait_time ). 341 | 342 | IF abap_true = l_attributes-properties-has_versions AND 343 | handle->_lock IS NOT INITIAL. 344 | * we may need a second try in case of class constructors 345 | handle->_attach_update70( 346 | EXPORTING area_name = handle->area_name 347 | mode = cl_shm_area=>attach_mode_wait_2nd_try 348 | IMPORTING root = l_root 349 | CHANGING wait_time = l_wait_time ). 350 | ENDIF. 351 | 352 | ENDWHILE. 353 | 354 | ENDIF. 355 | 356 | handle->root ?= l_root. 357 | 358 | * < 359 | 360 | ELSE. 361 | 362 | TRY. 363 | 364 | * > 365 | 366 | CREATE OBJECT handle. 367 | 368 | handle->client = l_client. 369 | handle->inst_name = inst_name. 370 | 371 | cl_shm_service=>initialize( 372 | EXPORTING area_name = handle->area_name 373 | client = l_client 374 | IMPORTING attributes = l_attributes 375 | ). 376 | 377 | handle->properties = l_attributes-properties. 378 | 379 | handle->_attach_update70( 380 | EXPORTING area_name = handle->area_name 381 | mode = attach_mode 382 | IMPORTING root = l_root 383 | CHANGING wait_time = l_wait_time ). 384 | 385 | IF abap_true = l_attributes-properties-has_versions AND 386 | handle->_lock IS NOT INITIAL. 387 | * we may need a second try in case of class constructors 388 | handle->_attach_update70( 389 | EXPORTING area_name = handle->area_name 390 | mode = attach_mode 391 | IMPORTING root = l_root 392 | CHANGING wait_time = l_wait_time ). 393 | ENDIF. 394 | 395 | IF attach_mode = cl_shm_area=>attach_mode_wait AND 396 | handle->_lock IS INITIAL. 397 | 398 | l_wait_time_per_loop = l_wait_time / 10. 399 | * wait_time_per_loop should be at least 2 * SHMATTACHWRITE_MAXACTIVEWAIT 400 | IF l_wait_time_per_loop < 2000. 401 | l_wait_time_per_loop = 2000. 402 | ELSEIF l_wait_time_per_loop > 300000. 403 | l_wait_time_per_loop = 300000. 404 | ENDIF. 405 | 406 | l_wait_time_per_loop_sec = l_wait_time_per_loop / 1000. 407 | 408 | WHILE handle->_lock IS INITIAL. 409 | 410 | IF l_wait_time_per_loop > l_wait_time. 411 | l_wait_time_per_loop = l_wait_time. 412 | l_wait_time_per_loop_sec = l_wait_time_per_loop / 1000. 413 | ENDIF. 414 | 415 | WAIT UP TO l_wait_time_per_loop_sec SECONDS. 416 | l_wait_time = l_wait_time - l_wait_time_per_loop. 417 | 418 | handle->_attach_update70( 419 | EXPORTING 420 | area_name = handle->area_name 421 | mode = cl_shm_area=>attach_mode_wait_2nd_try 422 | IMPORTING 423 | root = l_root 424 | CHANGING 425 | wait_time = l_wait_time ). 426 | 427 | IF abap_true = l_attributes-properties-has_versions AND 428 | handle->_lock IS NOT INITIAL. 429 | * we may need a second try in case of class constructors 430 | handle->_attach_update70( 431 | EXPORTING 432 | area_name = handle->area_name 433 | mode = cl_shm_area=>attach_mode_wait_2nd_try 434 | IMPORTING 435 | root = l_root 436 | CHANGING 437 | wait_time = l_wait_time ). 438 | ENDIF. 439 | 440 | ENDWHILE. 441 | 442 | ENDIF. 443 | 444 | handle->root ?= l_root. 445 | 446 | * < 447 | _trace_service->trin_attach_for_update( 448 | area_name = area_name 449 | inst_name = inst_name 450 | client = l_client 451 | mode = attach_mode 452 | wait_time = wait_time 453 | ). 454 | 455 | CLEANUP INTO l_cx. 456 | _trace_service->trcx_attach_for_update( 457 | area_name = area_name 458 | inst_name = inst_name 459 | client = l_client 460 | mode = attach_mode 461 | wait_time = wait_time 462 | cx = l_cx 463 | ). 464 | ENDTRY. 465 | 466 | ENDIF. 467 | 468 | handle->inst_trace_service = _trace_service. 469 | handle->inst_trace_active = _trace_active. 470 | 471 | endmethod. 472 | 473 | 474 | method ATTACH_FOR_WRITE. 475 | 476 | DATA: 477 | l_attributes TYPE shma_attributes, 478 | l_cx TYPE REF TO cx_root, 479 | l_client TYPE shm_client, 480 | l_client_supplied TYPE abap_bool, "#EC NEEDED 481 | l_wait_time TYPE i, 482 | l_wait_time_per_loop TYPE i, 483 | l_wait_time_per_loop_sec TYPE f. 484 | 485 | l_wait_time = wait_time. 486 | 487 | * check if tracing should be activated/de-activated 488 | IF ( NOT _trace_service IS INITIAL ). 489 | TRY. 490 | _trace_active = 491 | cl_shm_service=>trace_is_variant_active( 492 | _trace_service->variant-def_name 493 | ). 494 | CATCH cx_root. "#EC NO_HANDLER 495 | "#EC CATCH_ALL 496 | ENDTRY. 497 | ENDIF. 498 | 499 | 500 | IF _trace_active = abap_false OR 501 | _trace_service->variant-attach_for_write = abap_false. 502 | 503 | * > 504 | 505 | CREATE OBJECT handle. 506 | 507 | handle->client = l_client. 508 | handle->inst_name = inst_name. 509 | 510 | cl_shm_service=>initialize( 511 | EXPORTING area_name = handle->area_name 512 | client = l_client 513 | IMPORTING attributes = l_attributes 514 | ). 515 | 516 | handle->properties = l_attributes-properties. 517 | 518 | handle->_attach_write70( 519 | EXPORTING 520 | area_name = handle->area_name 521 | mode = attach_mode 522 | CHANGING 523 | wait_time = l_wait_time ). 524 | 525 | IF attach_mode = cl_shm_area=>attach_mode_wait AND 526 | handle->_lock IS INITIAL. 527 | 528 | l_wait_time_per_loop = l_wait_time / 10. 529 | * wait_time_per_loop should be at least 2 * SHMATTACHWRITE_MAXACTIVEWAIT 530 | IF l_wait_time_per_loop < 2000. 531 | l_wait_time_per_loop = 2000. 532 | ELSEIF l_wait_time_per_loop > 300000. 533 | l_wait_time_per_loop = 300000. 534 | ENDIF. 535 | 536 | l_wait_time_per_loop_sec = l_wait_time_per_loop / 1000. 537 | 538 | WHILE handle->_lock IS INITIAL. 539 | 540 | IF l_wait_time_per_loop > l_wait_time. 541 | l_wait_time_per_loop = l_wait_time. 542 | l_wait_time_per_loop_sec = l_wait_time_per_loop / 1000. 543 | ENDIF. 544 | 545 | WAIT UP TO l_wait_time_per_loop_sec SECONDS. 546 | l_wait_time = l_wait_time - l_wait_time_per_loop. 547 | 548 | handle->_attach_write70( 549 | EXPORTING 550 | area_name = handle->area_name 551 | mode = cl_shm_area=>attach_mode_wait_2nd_try 552 | CHANGING 553 | wait_time = l_wait_time ). 554 | 555 | ENDWHILE. 556 | 557 | ENDIF. 558 | 559 | * < 560 | 561 | ELSE. 562 | 563 | TRY. 564 | 565 | * > 566 | 567 | CREATE OBJECT handle. 568 | 569 | handle->client = l_client. 570 | handle->inst_name = inst_name. 571 | 572 | cl_shm_service=>initialize( 573 | EXPORTING area_name = handle->area_name 574 | client = l_client 575 | IMPORTING attributes = l_attributes 576 | ). 577 | 578 | handle->properties = l_attributes-properties. 579 | 580 | handle->_attach_write70( 581 | EXPORTING 582 | area_name = handle->area_name 583 | mode = attach_mode 584 | CHANGING 585 | wait_time = l_wait_time ). 586 | 587 | IF attach_mode = cl_shm_area=>attach_mode_wait AND 588 | handle->_lock IS INITIAL. 589 | 590 | l_wait_time_per_loop = l_wait_time / 10. 591 | * wait_time_per_loop should be at least 2 * SHMATTACHWRITE_MAXACTIVEWAIT 592 | IF l_wait_time_per_loop < 2000. 593 | l_wait_time_per_loop = 2000. 594 | ELSEIF l_wait_time_per_loop > 300000. 595 | l_wait_time_per_loop = 300000. 596 | ENDIF. 597 | 598 | l_wait_time_per_loop_sec = l_wait_time_per_loop / 1000. 599 | 600 | WHILE handle->_lock IS INITIAL. 601 | 602 | IF l_wait_time_per_loop > l_wait_time. 603 | l_wait_time_per_loop = l_wait_time. 604 | l_wait_time_per_loop_sec = l_wait_time_per_loop / 1000. 605 | ENDIF. 606 | 607 | WAIT UP TO l_wait_time_per_loop_sec SECONDS. 608 | l_wait_time = l_wait_time - l_wait_time_per_loop. 609 | 610 | handle->_attach_write70( 611 | EXPORTING 612 | area_name = handle->area_name 613 | mode = cl_shm_area=>attach_mode_wait_2nd_try 614 | CHANGING 615 | wait_time = l_wait_time ). 616 | 617 | ENDWHILE. 618 | 619 | ENDIF. 620 | 621 | * < 622 | 623 | _trace_service->trin_attach_for_write( 624 | area_name = area_name 625 | inst_name = inst_name 626 | client = l_client 627 | mode = attach_mode 628 | wait_time = wait_time 629 | ). 630 | CLEANUP INTO l_cx. 631 | _trace_service->trcx_attach_for_write( 632 | area_name = area_name 633 | inst_name = inst_name 634 | client = l_client 635 | mode = attach_mode 636 | wait_time = wait_time 637 | cx = l_cx 638 | ). 639 | ENDTRY. 640 | 641 | ENDIF. 642 | 643 | handle->inst_trace_service = _trace_service. 644 | handle->inst_trace_active = _trace_active. 645 | 646 | endmethod. 647 | 648 | 649 | method BUILD. 650 | 651 | DATA: 652 | l_cls_name TYPE shm_auto_build_class_name, 653 | l_cx TYPE REF TO cx_root. 654 | 655 | IF _trace_active = abap_false OR 656 | _trace_service->variant-build = abap_false. 657 | 658 | * > 659 | l_cls_name = 660 | cl_shm_service=>get_auto_build_class_name( area_name ). 661 | 662 | CALL METHOD (l_cls_name)=>if_shm_build_instance~build 663 | EXPORTING 664 | inst_name = inst_name. 665 | * < 666 | 667 | ELSE. 668 | 669 | TRY. 670 | 671 | * > 672 | l_cls_name = 673 | cl_shm_service=>get_auto_build_class_name( area_name ). 674 | 675 | CALL METHOD (l_cls_name)=>if_shm_build_instance~build 676 | EXPORTING 677 | inst_name = inst_name. 678 | * < 679 | _trace_service->trin_build( 680 | area_name = area_name 681 | inst_name = inst_name 682 | ). 683 | 684 | CLEANUP INTO l_cx. 685 | _trace_service->trcx_build( 686 | area_name = area_name 687 | inst_name = inst_name 688 | cx = l_cx 689 | ). 690 | ENDTRY. 691 | 692 | ENDIF. 693 | 694 | endmethod. 695 | 696 | 697 | method CLASS_CONSTRUCTOR. 698 | 699 | * TRACE { DO NOT REMOVE THIS LINE ! 700 | _trace_active = abap_false. 701 | TRY. 702 | _trace_service = 703 | cl_shm_service=>trace_get_service( area_name ). 704 | IF NOT _trace_service IS INITIAL. 705 | _trace_active = 706 | cl_shm_service=>trace_is_variant_active( 707 | _trace_service->variant-def_name 708 | ). 709 | ENDIF. 710 | CATCH cx_root. "#EC NO_HANDLER 711 | "#EC CATCH_ALL 712 | ENDTRY. 713 | * TRACE } DO NOT REMOVE THIS LINE ! 714 | 715 | endmethod. 716 | 717 | 718 | method DETACH_AREA. 719 | 720 | DATA: 721 | l_client TYPE shm_client, 722 | l_client_supplied TYPE abap_bool VALUE abap_false. 723 | 724 | 725 | * > 726 | rc = _detach_area71( area_name = area_name 727 | client = l_client 728 | client_supplied = l_client_supplied 729 | client_dependent = _client_dependent 730 | life_context = _life_context 731 | ). 732 | * < 733 | 734 | IF _trace_active = abap_true. 735 | IF _trace_service->variant-detach_area = abap_true. 736 | _trace_service->trin_detach_area( 737 | area_name = area_name 738 | client = l_client 739 | rc = rc 740 | ). 741 | ENDIF. 742 | ENDIF. 743 | 744 | endmethod. 745 | 746 | 747 | method FREE_AREA. 748 | 749 | DATA: 750 | l_client TYPE shm_client, 751 | l_client_supplied TYPE abap_bool VALUE abap_false. 752 | 753 | * GEN_INFO_INSERT_AFFECT_LOCAL_SERVER 754 | 755 | 756 | * > 757 | rc = _free_area71( area_name = area_name 758 | client = l_client 759 | client_supplied = l_client_supplied 760 | client_dependent = _client_dependent 761 | transactional = _transactional 762 | terminate_changer = terminate_changer 763 | affect_server = affect_server 764 | life_context = _life_context ). 765 | * < 766 | 767 | IF _trace_active = abap_true. 768 | IF _trace_service->variant-free_area = abap_true. 769 | _trace_service->trin_free_area( 770 | area_name = area_name 771 | client = l_client 772 | terminate_changer = terminate_changer 773 | affect_server = affect_server 774 | rc = rc 775 | ). 776 | ENDIF. 777 | ENDIF. 778 | 779 | endmethod. 780 | 781 | 782 | method FREE_INSTANCE. 783 | 784 | DATA: 785 | l_client TYPE shm_client, 786 | l_client_supplied TYPE abap_bool VALUE abap_false. 787 | 788 | * GEN_INFO_INSERT_AFFECT_LOCAL_SERVER 789 | 790 | 791 | * > 792 | rc = _free_instance71( area_name = area_name 793 | inst_name = inst_name 794 | client = l_client 795 | client_supplied = l_client_supplied 796 | client_dependent = _client_dependent 797 | transactional = _transactional 798 | terminate_changer = terminate_changer 799 | affect_server = affect_server 800 | life_context = _life_context ). 801 | * < 802 | 803 | IF _trace_active = abap_true. 804 | IF _trace_service->variant-free_instance = abap_true. 805 | _trace_service->trin_free_instance( 806 | area_name = area_name 807 | inst_name = inst_name 808 | client = l_client 809 | terminate_changer = terminate_changer 810 | affect_server = affect_server 811 | rc = rc 812 | ). 813 | ENDIF. 814 | ENDIF. 815 | 816 | endmethod. 817 | 818 | 819 | method GET_GENERATOR_VERSION. 820 | generator_version = _version_. 821 | endmethod. 822 | 823 | 824 | method GET_INSTANCE_INFOS. 825 | 826 | DATA: 827 | l_client TYPE shm_client, 828 | l_client_supplied TYPE abap_bool VALUE abap_false, 829 | l_inst_name_supplied TYPE abap_bool VALUE abap_false. 830 | 831 | 832 | IF inst_name IS SUPPLIED. 833 | l_inst_name_supplied = abap_true. 834 | ENDIF. 835 | 836 | * > 837 | TRY. 838 | CALL METHOD ('_GET_INSTANCE_INFOS804') 839 | EXPORTING 840 | area_name = area_name 841 | client = l_client 842 | client_supplied = l_client_supplied 843 | client_dependent = _client_dependent 844 | life_context = _life_context 845 | inst_name = inst_name 846 | inst_name_supplied = l_inst_name_supplied 847 | RECEIVING 848 | infos = infos. 849 | CATCH cx_sy_dyn_call_illegal_method. 850 | * New kernel and/or new basis SP missing -> use slow fallback 851 | infos = _get_instance_infos71( 852 | area_name = area_name 853 | client = l_client 854 | client_supplied = l_client_supplied 855 | client_dependent = _client_dependent 856 | life_context = _life_context 857 | ). 858 | IF abap_true = l_inst_name_supplied. 859 | DELETE infos WHERE name <> inst_name. 860 | ENDIF. 861 | ENDTRY. 862 | * < 863 | 864 | IF _trace_active = abap_true. 865 | IF _trace_service->variant-get_instance_inf = abap_true. 866 | _trace_service->trin_get_instance_infos( 867 | area_name = area_name 868 | inst_name = inst_name 869 | client = l_client 870 | infos = infos 871 | ). 872 | ENDIF. 873 | ENDIF. 874 | 875 | endmethod. 876 | 877 | 878 | method GET_ROOT. 879 | 880 | DATA: 881 | l_cx TYPE REF TO cx_root, 882 | l_area_name TYPE string, 883 | l_inst_name TYPE string, 884 | l_client TYPE string. 885 | 886 | IF _trace_active = abap_false OR 887 | _trace_service->variant-get_root = abap_false. 888 | 889 | * > 890 | IF is_valid( ) = abap_false. 891 | l_area_name = me->area_name. 892 | l_inst_name = me->inst_name. 893 | l_client = me->client. 894 | RAISE EXCEPTION TYPE cx_shm_already_detached 895 | EXPORTING 896 | area_name = l_area_name 897 | inst_name = l_inst_name 898 | client = l_client. 899 | ENDIF. 900 | root = me->root. 901 | * < 902 | 903 | ELSE. 904 | 905 | TRY. 906 | 907 | * > 908 | IF is_valid( ) = abap_false. 909 | l_area_name = me->area_name. 910 | l_inst_name = me->inst_name. 911 | l_client = me->client. 912 | RAISE EXCEPTION TYPE cx_shm_already_detached 913 | EXPORTING 914 | area_name = l_area_name 915 | inst_name = l_inst_name 916 | client = l_client. 917 | ENDIF. 918 | root = me->root. 919 | * < 920 | 921 | _trace_service->trin_get_root( 922 | area_name = area_name 923 | ). 924 | 925 | CLEANUP INTO l_cx. 926 | _trace_service->trcx_get_root( 927 | area_name = area_name 928 | cx = l_cx 929 | ). 930 | ENDTRY. 931 | 932 | ENDIF. 933 | 934 | endmethod. 935 | 936 | 937 | method INVALIDATE_AREA. 938 | 939 | DATA: 940 | l_client TYPE shm_client, 941 | l_client_supplied TYPE abap_bool VALUE abap_false. 942 | 943 | * GEN_INFO_INSERT_AFFECT_LOCAL_SERVER 944 | 945 | 946 | * > 947 | rc = _invalidate_area71( area_name = area_name 948 | client = l_client 949 | client_supplied = l_client_supplied 950 | client_dependent = _client_dependent 951 | transactional = _transactional 952 | terminate_changer = terminate_changer 953 | affect_server = affect_server 954 | life_context = _life_context ). 955 | * < 956 | 957 | IF _trace_active = abap_true. 958 | IF _trace_service->variant-invalidate_area = abap_true. 959 | _trace_service->trin_invalidate_area( 960 | area_name = area_name 961 | client = l_client 962 | terminate_changer = terminate_changer 963 | affect_server = affect_server 964 | rc = rc 965 | ). 966 | ENDIF. 967 | ENDIF. 968 | 969 | endmethod. 970 | 971 | 972 | method INVALIDATE_INSTANCE. 973 | 974 | DATA: 975 | l_client TYPE shm_client, 976 | l_client_supplied TYPE abap_bool value abap_false. 977 | 978 | * GEN_INFO_INSERT_AFFECT_LOCAL_SERVER 979 | 980 | 981 | * > 982 | rc = _invalidate_instance71( 983 | area_name = area_name 984 | inst_name = inst_name 985 | client = l_client 986 | client_supplied = l_client_supplied 987 | client_dependent = _client_dependent 988 | transactional = _transactional 989 | terminate_changer = terminate_changer 990 | affect_server = affect_server 991 | life_context = _life_context 992 | ). 993 | * < 994 | 995 | IF _trace_active = abap_true. 996 | IF _trace_service->variant-invalidate_inst = abap_true. 997 | _trace_service->trin_invalidate_instance( 998 | area_name = area_name 999 | inst_name = inst_name 1000 | client = l_client 1001 | terminate_changer = terminate_changer 1002 | affect_server = affect_server 1003 | rc = rc 1004 | ). 1005 | ENDIF. 1006 | ENDIF. 1007 | 1008 | endmethod. 1009 | 1010 | 1011 | method SET_ROOT. 1012 | 1013 | DATA: 1014 | l_cx TYPE REF TO cx_root. 1015 | 1016 | IF _trace_active = abap_false OR 1017 | _trace_service->variant-set_root = abap_false. 1018 | 1019 | * > 1020 | _set_root( root ). 1021 | me->root = root. 1022 | * < 1023 | 1024 | ELSE. 1025 | 1026 | TRY. 1027 | 1028 | * > 1029 | _set_root( root ). 1030 | me->root = root. 1031 | * < 1032 | _trace_service->trin_set_root( 1033 | area_name = area_name 1034 | inst_name = inst_name 1035 | root = root 1036 | ). 1037 | 1038 | CLEANUP INTO l_cx. 1039 | _trace_service->trcx_set_root( 1040 | area_name = area_name 1041 | inst_name = inst_name 1042 | root = root 1043 | cx = l_cx 1044 | ). 1045 | ENDTRY. 1046 | 1047 | ENDIF. 1048 | 1049 | endmethod. 1050 | ENDCLASS. 1051 | --------------------------------------------------------------------------------