guiserver/newlisp-edit.lsp

   1 #!/usr/bin/newlisp
   2
   3 ; newlisp-edit.lsp - multiple tab LISP editor and support for running code from the editor
   4
   5 ; version 1.10
   6
   7 ;(set 'debug-on true) ; special debug for aux communications
   8
   9 (set-locale "C")
  10
  11 ;;;; initialization
  12 (set 'newlispDir (env "NEWLISPDIR"))
  13
  14 (set 'newlispDoc (if (= ostype "Win32")
  15         newlispDir "/usr/share/doc/newlisp"))
  16
  17 (load (string newlispDir "/guiserver.lsp"))
  18
  19 (constant (global '$HOME) (or (env "HOME") (env "USERPROFILE") (env "DOCUMENT_ROOT") ""))
  20 (constant '$TEMP (if (= ostype "Win32") (or (env "TEMP") "C:\\temp") "/tmp"))
  21
  22 (if (= ostype "Win32")
  23         (begin
  24                 (set 'userSettingsDir (string
  25                         (or (env "APPDATA") (env "HOME") (env "USERPROFILE") (env "DOCUMENT_ROOT")) "/newLISP"))
  26                 (set 'userSettingsPath (append userSettingsDir "/newlisp-edit.config"))
  27                 (set 'recentFilesPath (append userSettingsDir "/newlisp-edit-recent"))
  28                 (if (not (directory userSettingsDir)) (make-dir userSettingsDir))
  29         )
  30         (begin
  31                 (set 'userSettingsPath (append $HOME "/.newlisp-edit.conf"))
  32                 (set 'recentFilesPath (append $HOME "/.newlisp-edit-recent"))
  33         )
  34 )
  35
  36 ;; init guiserver
  37
  38 (gs:init)
  39 ;(gs:set-trace true)
  40
  41
  42 ;; create default user settings
  43
  44 (gs:get-screen)
  45 (set 'config:currentAppWidth 800)
  46 (set 'config:currentAppHeight (- (gs:screen 1) 80))
  47 (set 'config:currentAppX (/ (- (gs:screen 0) config:currentAppWidth) 3))
  48 (set 'config:currentAppY (/ (- (gs:screen 1) config:currentAppHeight) 2))
  49 (set 'config:currentForeground '(0.0 0.0 0.2))
  50 (set 'config:currentBackground '(1.0 1.0 1.0))
  51 (set 'config:currentDir $HOME)
  52 (set 'config:currentFontName (if (= ostype "Win32") "Monospaced" "Lucida Sans Typewriter"))
  53 (set 'config:currentFontSize (if (= ostype "Win32") 14 13))
  54 (set 'config:currentMonitorFontSize (if (= ostype "Win32") 14 13))
  55 (set 'config:currentToolbarFloatable "no")
  56 (set 'config:currentTabsize 16)
  57 (set 'config:currentTabsPosition "top")
  58 (set 'config:currentToolbarShow "yes")
  59 (set 'config:currentThemeIdx 0)
  60 (set 'config:currentAltShell "")
  61 (set 'config:currentMonitorForeground '(0.1 0.1 0.5))
  62 (set 'config:currentMonitorBackground '(0.95 0.95 0.95))
  63
  64 ;; configure themes
  65
  66 ; background, foreground, caret, selection
  67 ; comments, keywords, strings
  68 ; numebers, quoted, parentheses
  69
  70 (set 'config:currentThemes '(
  71         ("Mozart" (1 1 1) (0 0 0) (0.5 0.5 0.8) (0.7 0.7 1.0)
  72                 (0.5 0.5 0.5) (0 0 0.75)        (0 0.5 0.0)
  73                 (0.50 0.5 0)    (0.350 0.350 0.50)      (0.50 0 0))
  74
  75         ("Herrmann" (0.3242 0.3984 0.4648) (0.6875 0.6992 0.5781) (0.918 0.4961 0.1016) (0.2773 0.3164 0.4258)
  76                 (0.5 0.5781 0.597)      (0.125 0.2031 0.332)    (0.5547 0.6562 0.6562)
  77                 (0.8203 0.6055 0.1953)  (0.8203 0.6055 0.1953)  (0.125 0.2031 0.332))
  78
  79         ("Shostakovich" (0.2 0.2 0.2) (0.9 0.9 0.9) (0.7 0.7 0.7) (0.8 0.8 1.0)
  80                 (0.6 0.6 0.6)   (0.9 0.9 0.3) (0.4 0.9 0.4)
  81                 (0.75 0.75 0.95) (0.5 0.5 0.9) (1.0 0.3 0.3))
  82 ))
  83
  84 ;; initialize script list
  85 (set 'config:currentScripts
  86         (list
  87                 (list "Word count" (string newlispDir "/guiserver/word-count.lsp") "content")
  88                 (list "Uppercase" (string newlispDir "/guiserver/uppercase.lsp") "selection" "F4")
  89 ))
  90
  91 ;; menu-item handler for themes
  92 (define (theme-handler id)
  93   ; extract theme index from id string and extract theme from list
  94         (letn ( (idx (int (9 id))) (T (config:currentThemes idx)) )
  95                 (gs:set-background currentEdit (T 1))
  96                 (set 'currentBackground (T 1))
  97                 (gs:set-foreground currentEdit (T 2))
  98                 (set 'currentForeground (T 2))
  99                 (gs:set-caret-color currentEdit (T 3))
 100                 (gs:set-selection-color currentEdit (T 4))
 101                 (gs:set-syntax-colors (T 5) (T 6) (T 7) (T 8) (T 9) (T 10))
 102                 (gs:set-syntax currentEdit currentSyntaxStatus)
 103                 (gs:set-selected 'ViewSyntax (true? currentSyntaxStatus))
 104                 (set 'currentThemeIdx idx)
 105                 (dotimes (i (length config:currentThemes))
 106                         (gs:enable (string "ViewTheme" i)))
 107                 (gs:disable (string "ViewTheme" idx))
 108         )
 109 )
 110
 111 (define (current-file-syntax)
 112         (cond
 113                 ((ends-with currentFile ".lsp") "lsp")
 114                 ((ends-with currentFile ".c") "c")
 115                 ((ends-with currentFile ".cpp") "cpp")
 116                 ((ends-with currentFile ".h") "cpp")
 117                 ((ends-with currentFile ".java") "java")
 118                 ((ends-with currentFile ".php") "php")
 119                 (true nil)
 120         )
 121 )
 122
 123 ;; script-handler, saves current edit tab to a temporary file
 124 ;; and passes the file name as an argument to the script
 125 ;; scripts are registered in the settings file
 126 ;; scripts must exit or newlisp-edit will hang.
 127 (define (script-handler id)
 128         (letn ( (idx (int (10 id))) (S (config:currentScripts idx)))
 129                 (set 'currentScriptFile (S 1))
 130                 (if (file? currentScriptFile)
 131                         (begin
 132                                 (set 'currentScriptMode (S 2))
 133                                 (if (= currentScriptMode "selection")
 134                                         (gs:get-selected-text currentEdit 'script-execute)
 135                                 ; else "content"
 136                         (gs:get-text currentEdit 'script-execute))
 137                         )
 138                         (output-monitor (string "--- could not find script " currentScriptFile " ---\n"))
 139                 )
 140         )
 141 )
 142
 143 (define (script-execute id text)
 144         (if (not text) (set 'text "===="))
 145         (let (file (string $TEMP "/" (uuid)))
 146                 (if (= ostype "Win32")
 147                         (write-file file (replace "\n" (base64-dec text) "\r\n"))
 148                         (write-file file (base64-dec text)))
 149                 (if (= ostype "Win32")
 150                         (catch (exec (string {newlisp.exe "} currentScriptFile {" } file " > " (string file "out"))) 'result)
 151                         (catch (exec (string "/usr/bin/newlisp " currentScriptFile " " file)) 'result)
 152                 )
 153                 (if (list? result)
 154                         (begin
 155                                 (set 'result (if (= ostype "Win32")
 156                                         (read-file (string file "out"))
 157                                         (join result "\n")))
 158                                 (if (= currentScriptMode "selection")
 159                                         (paste-action result)
 160                                         (if (= ostype "Win32")
 161                                                 (output-monitor result)
 162                                                 (output-monitor (string result "\n")))
 163                                 )
 164                         )
 165                         (output-monitor result)
 166                 )
 167                 (if (= ostype "Win32") (delete-file (string file "out")))
 168                 (delete-file file)
 169         )
 170 )
 171
 172
 173
 174 ;; if newlisp-edit.config exists load user-settings
 175 (if (file? userSettingsPath)
 176         (if (not (catch (load userSettingsPath) 'result))
 177                 (set 'loadUserSettingsError result))
 178         (if (not (catch (save userSettingsPath 'config) 'result))
 179                 (set 'loadUserSettingsError result))
 180 )
 181
 182 (if (not        (catch (load recentFilesPath) 'result))
 183         (set 'recentFiles '()))
 184
 185 (set 'currentAppX config:currentAppX)
 186 (set 'currentAppY config:currentAppY)
 187 (set 'currentAppWidth config:currentAppWidth)
 188 (set 'currentAppHeight config:currentAppHeight)
 189 (set 'currentForeground config:currentForeground)
 190 (set 'currentBackground config:currentBackground)
 191 (set 'currentDir config:currentDir)
 192 (set 'currentFile "Untitled.lsp")
 193 (set 'currentFontName config:currentFontName)
 194 (set 'currentFontSize config:currentFontSize)
 195 (set 'currentMonitorFontSize config:currentMonitorFontSize)
 196 (set 'currentToolbarFloatable config:currentToolbarFloatable)
 197 (set 'currentTabsPosition config:currentTabsPosition)
 198 (set 'currentToolbarShow config:currentToolbarShow)
 199 (set 'currentThemeIdx config:currentThemeIdx)
 200 (set 'currentAltShell config:currentAltShell)
 201 (set 'currentMonitorForeground config:currentMonitorForeground)
 202 (set 'currentMonitorBackground config:currentMonitorBackground)
 203
 204 (set 'currentPath (string currentDir "/" currentFile))
 205 (set 'currentSyntaxStatus "lsp")
 206
 207
 208 ;(gs:set-look-and-feel "com.sun.java.swing.plaf.motif.MotifLookAndFeel")
 209 ;(gs:set-look-and-feel "javax.swing.plaf.metal.MetalLookAndFeel")
 210 ;(gs:set-look-and-feel "com.sun.java.swing.plaf.windows.WindowsLookAndFeel")
 211 ;(gs:set-look-and-feel "javax.swing.plaf.mac.MacLookAndFeel")
 212 ;(gs:set-look-and-feel "com.sun.java.swing.plaf.gtk.GTKLookAndFeel")
 213
 214 (define (start-newlisp-shell)
 215         (if (= ostype "Win32")
 216                 (gs:run-shell 'OutputArea (string newlispDir "/newlisp.exe -C -w " $HOME))
 217                 (gs:run-shell 'OutputArea (string "/usr/bin/newlisp -C -w " $HOME))
 218         )
 219 )
 220
 221 (define (startshell-handler)
 222         (gs:run-shell 'OutputArea currentAltShell)
 223 )
 224
 225 ;;;; describe the GUI ;;;;;;;;;;;;;;;;;;;;;;;
 226
 227 (gs:frame 'TheEditor currentAppX currentAppY currentAppWidth currentAppHeight "newLISP edit")
 228 (gs:frame-closed 'TheEditor 'quitbutton-handler)
 229
 230 (set 'default-currentFontName currentFontName)
 231
 232 (gs:set-border-layout 'TheEditor 0 0)
 233 (gs:tool-bar 'ToolBar (= currentToolbarFloatable "yes"))
 234 (gs:set-flow-layout 'ToolBar "left" 18 5)
 235 (gs:image-button 'NewButton 'newbutton-handler "/local/new32.png" "/local/new-down32.png")
 236 (gs:image-button 'ClearButton 'clearbutton-handler "/local/clear32.png" "/local/clear-down32.png")
 237 (gs:image-button 'LoadButton 'loadbutton-handler "/local/folder-opened32.png" "/local/folder-opened-down32.png")
 238 (gs:image-button 'SaveButton 'savebutton-handler "/local/save32.png" "/local/save-down32.png")
 239 (gs:image-button 'CutButton 'cutbutton-handler "/local/cut32.png" "/local/cut-down32.png")
 240 (gs:image-button 'CopyButton 'copybutton-handler "/local/copy32.png" "/local/copy-down32.png")
 241 (gs:image-button 'PasteButton 'pastebutton-handler "/local/paste32.png" "/local/paste-down32.png")
 242 (gs:image-button 'FindButton 'findbutton-handler "/local/search32.png" "/local/search-down32.png")
 243 (gs:image-button 'ExecButton 'process-or-execbutton-handler "/local/run32.png" "/local/run-down32.png")
 244 (gs:image-button 'RestartButton 'start-newlisp-shell "/local/restart32.png" "/local/restart-down32.png")
 245 (gs:image-button 'FontBookButton 'fontbookbutton-handler "/local/font-book32.png" "/local/font-book-down32.png")
 246 (gs:set-tool-tip 'NewButton "Open a new tab")
 247 (gs:set-tool-tip 'LoadButton  "Load file into editor")
 248 (gs:set-tool-tip 'SaveButton "Save file in editor")
 249 (gs:set-tool-tip 'ClearButton "Clear editor panel")
 250 (gs:set-tool-tip 'CutButton "Cut selection to clipboard")
 251 (gs:set-tool-tip 'CopyButton "Copy selection to clipboard")
 252 (gs:set-tool-tip 'PasteButton "Paste from clipboard")
 253 (gs:set-tool-tip 'FindButton "Find")
 254
 255 (gs:set-tool-tip 'ExecButton "Run editor content")
 256 (gs:set-tool-tip 'RestartButton "Restart auxiliary newLISP process")
 257 (gs:set-tool-tip 'FontBookButton "Select editor font")
 258
 259 (gs:add-to 'ToolBar 'NewButton 'LoadButton 'SaveButton)
 260 (gs:add-separator 'ToolBar)
 261 (gs:add-to 'ToolBar 'ClearButton 'CutButton 'CopyButton 'PasteButton)
 262 (gs:add-separator 'ToolBar)
 263 (gs:add-to 'ToolBar 'FindButton)
 264 (gs:add-separator 'ToolBar)
 265 (gs:add-to 'ToolBar 'ExecButton 'RestartButton)
 266 (gs:add-separator 'ToolBar)
 267 (gs:add-to 'ToolBar 'FontBookButton)
 268
 269 (gs:panel 'FontPanel 46 18)
 270 (gs:set-grid-layout 'FontPanel 1 3)
 271 (gs:label 'FontSmallerLabel "A" "center")
 272 (gs:label 'FontSizeLabel (string currentFontSize) "center")
 273 (gs:label 'FontBiggerLabel "A" "center")
 274 (gs:set-tool-tip 'FontSizeLabel "Font size" "right")
 275 (gs:set-font 'FontSmallerLabel "Lucida Sans Regular" 10 "italic")
 276 (gs:set-font 'FontSizeLabel "Lucida Sans Regular" 10 "plain")
 277 (gs:set-font 'FontBiggerLabel "Lucida Sans Regular" 13 "italic")
 278 (gs:add-to 'FontPanel 'FontSmallerLabel 'FontSizeLabel 'FontBiggerLabel)
 279
 280 (gs:add-to 'ToolBar 'FontPanel)
 281
 282 (gs:mouse-event 'FontBiggerLabel 'fontpanel-event)
 283 (gs:mouse-event 'FontSmallerLabel 'fontpanel-event)
 284
 285 (gs:set-tool-tip 'FontBiggerLabel "Bigger font")
 286 (gs:set-tool-tip 'FontSmallerLabel "Smaller font")
 287
 288 ;; disable Cut- and Copy- buttons until selection is make
 289 ;; SaveButton util content in EditArea
 290 (gs:disable 'CutButton 'CopyButton 'SaveButton)
 291
 292 (if (= currentToolbarShow "yes")
 293         (gs:add-to 'TheEditor 'ToolBar "north"))
 294
 295 (set 'tabs-stack '())
 296
 297 ;; configure text area
 298 (define (make-editor-tab dir file-name)
 299         (let (edit-tab (append "tab-" (uuid)) )
 300                 (push (list edit-tab dir file-name (list true 0 0)) tabs-stack -1)
 301                 (gs:text-pane edit-tab 'editarea-handler "text/plain")
 302                 (gs:mouse-event edit-tab 'editarea-mouse-handler)
 303                 (gs:set-foreground edit-tab currentForeground)
 304                 (gs:set-background edit-tab currentBackground)
 305                 (gs:set-tab-size edit-tab config:currentTabsize)
 306                 (gs:set-font edit-tab currentFontName currentFontSize "plain")
 307         edit-tab)
 308 )
 309
 310 (set 'currentDot 0 'currentMark 0)
 311 (set 'edit-buffer-clean true)
 312 (set 'currentEdit (make-editor-tab currentDir currentFile))
 313 (gs:set-syntax currentEdit (ends-with currentFile ".lsp"))
 314 (set 'currentTabIndex 0)
 315 (gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
 316
 317 (set 'editUndoCount 0)
 318
 319 (gs:tabbed-pane 'EditorTabs 'editortabs-handler currentTabsPosition
 320         currentEdit "Untitled.lsp")
 321
 322 (gs:set-icon 'EditorTabs "/local/green10.png" currentTabIndex)
 323
 324 ; configure output area
 325 (gs:text-area 'OutputArea 'gs:no-action)
 326 (gs:set-background 'OutputArea currentMonitorBackground)
 327 (gs:set-foreground 'OutputArea currentMonitorForeground)
 328 (gs:set-font 'OutputArea "Monospaced" currentMonitorFontSize "plain")
 329 (gs:split-pane 'TextPanel "horizontal" 0.70 0.5 5)
 330 (gs:add-to 'TextPanel 'EditorTabs 'OutputArea)
 331 (gs:add-to 'TheEditor  'TextPanel "center")
 332
 333 ;; configure main menu
 334 (gs:menu 'FileMenu "File")
 335 (gs:menu-item 'FileClear 'clearbutton-handler "Clear tab" true)
 336 (gs:menu-item 'FileNew 'newbutton-handler "New tab")
 337 (gs:menu-item 'FileOpen 'loadbutton-handler "Open ...")
 338 (gs:menu-item 'FileClose 'fileclose-handler "Close tab")
 339 (gs:menu-item 'FileSave 'savebutton-handler "Save")
 340 (gs:menu-item 'FileSaveAs 'saveasbutton-handler "Save As ...")
 341 (gs:menu-item 'FileSettings 'savesettings-handler "Save Settings")
 342 (gs:menu-item 'FileQuit 'quitbutton-handler (if (= ostype "Win32") "Exit" "Quit"))
 343
 344 (gs:menu 'FileRecent "Recent Files")
 345
 346
 347 (if recentFiles (dolist (f recentFiles)
 348         (if (file? (f 1))
 349                 (begin
 350                         (gs:menu-item (f 0) 'recentfiles-handler (f 1))
 351                         (gs:add-to 'FileRecent (f 0)))
 352                 (replace f recentFiles))
 353 ))
 354
 355 (gs:menu 'EditMenu "Edit")
 356 (gs:menu-item 'EditUndo 'undo-handler "Undo")
 357 (gs:menu-item 'EditRedo 'redo-handler "Redo")
 358 (gs:menu-item 'EditCut 'cutbutton-handler "Cut")
 359 (gs:menu-item 'EditCopy 'copybutton-handler "Copy")
 360 (gs:menu-item 'EditPaste 'pastebutton-handler "Paste")
 361 (gs:menu-item 'EditGoto 'goto-handler "Goto Line")
 362 (gs:menu-item 'EditPosition 'position-handler "Get Position")
 363 (gs:menu-item 'EditGotoEditor 'switchwindow-handler "Goto Editor")
 364 (gs:menu-item 'EditGotoShell 'switchwindow-handler "Goto Shell")
 365 (gs:menu-item 'EditFind 'findbutton-handler "Find")
 366 (gs:menu-item 'EditFindNext 'findtextnext-action "Find next")
 367 (gs:menu-item 'EditFindPrevious 'findtextprevious-action "Find Previous")
 368 (gs:menu-item 'EditReplace 'findtextreplace-action "Replace Selection")
 369 ;(gs:menu-item 'EditReplaceNext 'findtextreplace-action "Replace Next")
 370 (gs:menu-item 'EditFindDispose 'finddispose-handler "Find Dispose")
 371
 372 (gs:menu-popup 'EditMenuPopup "Edit")
 373 (gs:menu-item 'EditCutP 'cutbutton-handler "Cut")
 374 (gs:menu-item 'EditCopyP 'copybutton-handler "Copy")
 375 (gs:menu-item 'EditPasteP 'pastebutton-handler "Paste")
 376
 377 (gs:menu 'ViewMenu "View")
 378 (gs:menu-item 'ViewClearMonitor 'viewclearmonitor-handler "Clear monitor")
 379 (gs:menu-item-check 'ViewToolbar 'viewtoolbar-handler "Toolbar" (= currentToolbarShow "yes"))
 380 (gs:menu-item-check 'ViewSyntax 'viewsyntax-handler "Syntax coloring" true)
 381 (dolist (T config:currentThemes)
 382         (gs:menu-item (string "ViewTheme" $idx) 'theme-handler (T 0)))
 383 (gs:menu-item 'ViewFontBook 'fontbookbutton-handler "Font faces ...")
 384 (gs:menu-item 'ViewFontSmaller 'viewfontsmaller-handler "Font smaller")
 385 (gs:menu-item 'ViewFontBigger 'viewfontbigger-handler "Font bigger")
 386
 387 (gs:menu 'ToolMenu "Tools")
 388 (gs:menu-item 'ToolEditSettings 'tooleditsettings-handler "Edit Settings")
 389 (dolist (T config:currentScripts)
 390         (gs:menu-item (string "ToolScript" $idx) 'script-handler (T 0))
 391         (if (= 4 (length T))
 392                 (gs:set-accelerator (string "ToolScript" $idx) (T 3)))
 393 )
 394
 395 (gs:menu 'HelpMenu "Help")
 396 (gs:menu-item 'HelpAbout 'helpabout-handler "About newLISP-GS")
 397 (gs:menu-item 'HelpManual 'helpmanual-handler "newLISP Manual and Reference")
 398 (gs:menu-item 'HelpDemos 'opendemos-handler "Open Demo Folder")
 399 (gs:menu-item 'HelpGuiserver 'helpguiserver-handler "GS Manual")
 400
 401 (gs:menu 'RunMenu "Run")
 402 (gs:menu-item 'RunRun 'process-or-execbutton-handler "Run")
 403 (gs:set-icon 'RunRun "/local/run16.png")
 404 (gs:menu-item 'RunRestart 'start-newlisp-shell "Restart")
 405 (gs:menu-item 'RunShell 'startshell-handler "Alternate shell")
 406
 407 (gs:menu-popup 'SyntaxMenu "Syntax")
 408 (gs:menu-item 'SyntaxNewlisp 'syntaxmenu-handler "newLISP syntax")
 409 (gs:menu-item 'SyntaxC 'syntaxmenu-handler "C syntax")
 410 (gs:menu-item 'SyntaxCPP 'syntaxmenu-handler "C++ syntax")
 411 (gs:menu-item 'SyntaxJava 'syntaxmenu-handler "Java syntax")
 412 (gs:menu-item 'SyntaxPHP 'syntaxmenu-handler "PHP syntax")
 413 (gs:add-to 'SyntaxMenu 'SyntaxNewlisp 'SyntaxC 'SyntaxCPP 'SyntaxJava 'SyntaxPHP)
 414
 415 (if (= ostype "OSX")
 416         (begin ;; MacOS X keyboard
 417                 (gs:set-accelerator 'FileClear "shift meta N")
 418                 (gs:set-accelerator 'FileNew "meta N")
 419                 (gs:set-accelerator 'FileOpen "meta O")
 420                 (gs:set-accelerator 'FileClose "meta W")
 421                 (gs:set-accelerator 'FileSave "meta S")
 422                 (gs:set-accelerator 'FileSaveAs "shift meta S")
 423                 (gs:set-accelerator 'EditUndo "meta Z")
 424                 (gs:set-accelerator 'EditRedo "shift meta Z")
 425                 (gs:set-accelerator 'EditCut "meta X")
 426                 (gs:set-accelerator 'EditCopy "meta C")
 427                 (gs:set-accelerator 'EditPaste "meta V")
 428                 (gs:set-accelerator 'EditGoto "meta L")
 429                 (gs:set-accelerator 'EditPosition "shift meta L")
 430                 (gs:set-accelerator 'EditGotoEditor "meta 1")
 431                 (gs:set-accelerator 'EditGotoShell "meta 2")
 432                 (gs:set-accelerator 'EditFind "meta F")
 433                 (gs:set-accelerator 'EditFindDispose "meta D")
 434                 (gs:set-accelerator 'EditFindPrevious "shift meta G")
 435                 (gs:set-accelerator 'EditFindNext "meta G")
 436                 (gs:set-accelerator 'EditReplace "meta J")
 437 ;               (gs:set-accelerator 'EditReplaceNext "shift meta J")
 438                 (gs:set-accelerator 'RunRun "meta R")
 439                 (gs:set-accelerator 'RunRestart "shift meta R")
 440                 (gs:set-accelerator 'ViewClearMonitor "meta M")
 441                 (gs:set-accelerator 'ViewFontBook "meta T")
 442                 (gs:set-accelerator 'ViewFontSmaller "meta MINUS")
 443                 (gs:set-accelerator 'ViewFontBigger "shift meta EQUALS")
 444                 (gs:set-accelerator 'ViewSyntax "meta Y")
 445         )
 446         (begin ;; PC keyboard
 447                 (gs:set-accelerator 'FileClear "ctrl N")
 448                 (gs:set-accelerator 'FileNew "shift ctrl N")
 449                 (gs:set-accelerator 'FileOpen "ctrl O")
 450                 (gs:set-accelerator 'FileClose "ctrl W")
 451                 (gs:set-accelerator 'FileSave "ctrl S")
 452                 (gs:set-accelerator 'FileSaveAs "shift ctrl S")
 453                 (gs:set-accelerator 'EditUndo "ctrl Z")
 454                 (gs:set-accelerator 'EditRedo "shift ctrl Z")
 455                 (gs:set-accelerator 'EditCopy "ctrl C")
 456                 (gs:set-accelerator 'EditCut "ctrl X")
 457                 (gs:set-accelerator 'EditPaste "ctrl V")
 458                 (gs:set-accelerator 'EditGoto "alt L")
 459                 (gs:set-accelerator 'EditPosition "shift alt L")
 460                 (gs:set-accelerator 'EditGotoEditor "alt 1")
 461                 (gs:set-accelerator 'EditGotoShell "alt 2")
 462                 (gs:set-accelerator 'EditFind "ctrl F")
 463                 (gs:set-accelerator 'EditFindPrevious "shift ctrl G")
 464                 (gs:set-accelerator 'EditFindNext "ctrl G")
 465                 (gs:set-accelerator 'EditFindDispose "ctrl D")
 466                 (gs:set-accelerator 'EditReplace "ctrl J")
 467 ;               (gs:set-accelerator 'EditReplaceNext "shift ctrl J")
 468                 (gs:set-accelerator 'RunRun "alt R")
 469                 (gs:set-accelerator 'RunRestart "shift alt R")
 470                 (gs:set-accelerator 'ViewClearMonitor "ctrl M")
 471                 (gs:set-accelerator 'ViewFontBook "ctrl T")
 472                 (gs:set-accelerator 'ViewFontSmaller "ctrl MINUS")
 473                 (gs:set-accelerator 'ViewFontBigger "ctrl EQUALS")
 474                 (gs:set-accelerator 'ViewSyntax "alt Y")
 475         )
 476 )
 477
 478 ;; disable Save and SaveAs until content in EditArea
 479 (gs:disable 'FileSave 'FileSaveAs)
 480 ;; disable Cut and Copy menu items until selection is made
 481 (gs:disable 'EditUndo 'EditRedo 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
 482 ;; disable various find dialog options until dialog is up first
 483 (gs:disable 'EditFindPrevious 'EditFindNext 'EditReplace 'EditFindDispose)
 484 ;; disable monitor clear until something is in it
 485 ;(gs:disable 'ViewClearMonitor)
 486
 487 ; File menu
 488 (gs:add-to 'FileMenu 'FileClear 'FileNew 'FileClose)
 489 (gs:add-separator 'FileMenu)
 490 (gs:add-to 'FileMenu 'FileRecent)
 491 (gs:add-separator 'FileMenu)
 492 (gs:add-to 'FileMenu 'FileOpen 'FileSave 'FileSaveAs)
 493 (gs:add-separator 'FileMenu)
 494 (gs:add-to 'FileMenu 'FileSettings)
 495 (gs:add-separator 'FileMenu)
 496 (gs:add-to 'FileMenu 'FileQuit)
 497
 498 ; Edit menun
 499 (gs:add-to 'EditMenu 'EditUndo 'EditRedo)
 500 (gs:add-separator 'EditMenu)
 501 (gs:add-to 'EditMenu 'EditCut 'EditCopy 'EditPaste)
 502 (gs:add-separator 'EditMenu)
 503 (gs:add-to 'EditMenu 'EditGoto 'EditPosition 'EditGotoEditor 'EditGotoShell)
 504 (gs:add-separator 'EditMenu)
 505 (gs:add-to 'EditMenu 'EditFind 'EditFindNext 'EditFindPrevious 'EditReplace)
 506 (gs:add-separator 'EditMenu)
 507 (gs:add-to 'EditMenu 'EditFindDispose)
 508 (gs:disable 'EditFindDispose)
 509 ; edit area popup
 510 (gs:add-to 'EditMenuPopup 'EditCutP 'EditCopyP 'EditPasteP)
 511
 512 ; View menu
 513 (gs:add-to 'ViewMenu 'ViewClearMonitor)
 514 (gs:add-separator 'ViewMenu)
 515 (gs:add-to 'ViewMenu 'ViewToolbar 'ViewSyntax)
 516 (gs:add-separator 'ViewMenu)
 517 (dolist (T config:currentThemes)
 518         (gs:add-to 'ViewMenu (string "ViewTheme" $idx)))
 519 (gs:add-separator 'ViewMenu)
 520 (gs:add-to 'ViewMenu 'ViewFontBook 'ViewFontSmaller 'ViewFontBigger)
 521
 522 (if (empty? currentAltShell)
 523         (gs:add-to 'RunMenu 'RunRun 'RunRestart)
 524         (gs:add-to 'RunMenu 'RunRun 'RunRestart 'RunShell))
 525
 526 ; Tool menu
 527 (gs:add-to 'ToolMenu 'ToolEditSettings)
 528 (gs:add-separator 'ToolMenu)
 529 (dolist (T config:currentScripts)
 530         (gs:add-to 'ToolMenu (string "ToolScript" $idx)))
 531
 532 ; Help menu
 533 ;; manuals are not added to Help on Win32 because open browser
 534 ;; prevents newlisp-edit/guiserever.jar from exiting
 535 (if (= ostype "Win32")
 536         (begin
 537                 (gs:add-to 'HelpMenu 'HelpDemos)
 538                 (gs:add-separator 'HelpMenu)
 539                 (gs:add-to 'HelpMenu 'HelpAbout))
 540         (begin
 541                 (gs:add-to 'HelpMenu 'HelpManual 'HelpGuiserver)
 542                 (gs:add-separator 'HelpMenu)
 543                 (gs:add-to 'HelpMenu 'HelpDemos)
 544                 (if (!= ostype "OSX")
 545                         (begin
 546                         (gs:add-separator 'HelpMenu)
 547                         (gs:add-to 'HelpMenu 'HelpAbout)
 548 ))))
 549
 550 (gs:menu-bar 'TheEditor 'FileMenu 'EditMenu 'RunMenu 'ViewMenu 'ToolMenu 'HelpMenu)
 551
 552 (gs:set-visible 'TheEditor true)
 553 (gs:dispose-splash)
 554
 555 ; start auxiliary shell newLISP process for evaluation of edit area in OutputArea
 556 (start-newlisp-shell)
 557
 558 (gs:request-focus currentEdit) ; set focus on editarea
 559
 560 ; check if user settings where loaded succesfully
 561 (if loadUserSettingsError
 562         (gs:message-dialog 'TheEditor (string "Problem loading: " userSettingsPath ".")
 563                 loadUserSettingsError "warning")
 564 )
 565
 566 ;;;; define actions
 567
 568 (define (clear-current-tab)
 569         (gs:clear-text currentEdit)
 570         (set 'currentDir $HOME)
 571         (set 'currentFile "Untitled.lsp")
 572         (set 'currentPath (string currentDir "/" currentFile))
 573         (set 'currentDot 0 'currentMark 0)
 574         (update-current-tab)
 575         (gs:disable 'SaveButton 'CutButton 'CopyButton 'FileSave 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
 576         (gs:set-icon 'EditorTabs "/local/green10.png" currentTabIndex)
 577         (gs:set-text 'EditorTabs currentFile currentTabIndex)
 578         (gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
 579 )
 580
 581 (define (fileclose-handler)
 582         (if (not edit-buffer-clean)
 583                 (gs:confirm-dialog 'TheEditor 'fileclose-action "Close file tab"
 584                         (string "Abandon unsaved " currentFile "?") "yes-no")
 585                 (fileclose-action 'TheEditor 0)
 586         )
 587 )
 588
 589 (define (fileclose-action id result)
 590         (if (= result 0)
 591                 (if (> (length tabs-stack) 1)
 592                         (begin
 593                                 (gs:remove-tab 'EditorTabs currentTabIndex)
 594                                 (replace-assoc currentEdit tabs-stack)
 595                                 (if (= currentTabIndex (length tabs-stack)) ; it was the right most tab
 596                                         (dec 'currentTabIndex)
 597                                         (begin ; its was not the most roght which was removed
 598                                                 (set 'currentEdit (first (tabs-stack currentTabIndex)))
 599                                                 (switch-to-tab currentEdit)
 600                                         )
 601                                 )
 602                         )
 603                         (clear-current-tab)
 604                 )
 605         )
 606 )
 607
 608 (define (newbutton-handler)
 609         (update-current-tab)
 610         (set 'currentDir $HOME)
 611         (set 'currentFile "Untitled.lsp")
 612         (set 'currentPath (string currentDir "/" currentFile))
 613         (set 'currentDot 0 'currentMark 0)
 614         (set 'edit-buffer-clean true)
 615         (set 'currentEdit (make-editor-tab currentDir currentFile))
 616         (gs:insert-tab 'EditorTabs currentEdit currentFile (length tabs-stack))
 617         (gs:request-focus 'EditorTabs (length tabs-stack))
 618         (gs:request-focus currentEdit) ; set focus in edit area
 619         (theme-handler (string "ViewTheme" currentThemeIdx))
 620 )
 621
 622 (define (recentfiles-handler id)
 623         (update-current-tab)
 624         (let (file (lookup id recentFiles))
 625                 (if (not (file? file))
 626                         (gs:message-dialog 'TheEditor "Loading file" (append "Cannot find: " file))
 627                         (begin
 628                                 (set 'currentPath (lookup id recentFiles))
 629                                 (open-currentpath-in-tab)
 630                         )
 631                 )
 632         )
 633 )
 634
 635 (define (loadbutton-handler id)
 636         (gs:open-file-dialog 'TheEditor 'openfile-action  currentDir
 637                 ".lsp .c .h .txt .java .htm .html .css .php .pl .py .rb .lisp .el .cl .cpp .tcl .config"
 638                 "Various text formats")
 639 )
 640
 641 (define (openfile-action id  op file)
 642         (if file
 643                 (begin
 644                         (update-current-tab)
 645                         (set 'currentPath (base64-dec file))
 646                         (open-currentpath-in-tab)
 647                 )
 648         )
 649 )
 650
 651 (define (open-currentpath-in-tab)
 652         (set 'currentDir (join (chop (parse currentPath {\\|/} 0)) "/" ))
 653         (set 'currentFile (last (parse currentPath {\\|/} 0)))
 654         (set 'currentEdit (make-editor-tab currentDir currentFile))
 655         (set 'edit-buffer-clean true)
 656         (set 'currentDot 0 'currentMark 0)
 657         (gs:insert-tab 'EditorTabs currentEdit currentFile (length tabs-stack))
 658         (gs:request-focus 'EditorTabs (length tabs-stack))
 659         (gs:request-focus currentEdit) ; set focus in edit area
 660         (gs:set-cursor currentEdit "wait")
 661
 662         (gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
 663         (gs:enable 'FileSaveAs)
 664
 665         (gs:load-text currentEdit currentPath)
 666         (set 'currentSyntaxStatus (current-file-syntax))
 667         (theme-handler (string "ViewTheme" currentThemeIdx))
 668         (gs:set-cursor currentEdit "default")
 669 )
 670
 671 (define (savebutton-handler id)
 672         (if (= currentFile "Untitled.lsp")
 673                 (saveasbutton-handler id)
 674                 (savefile-action id op (base64-enc currentPath) true)
 675         )
 676 )
 677
 678 (define (saveasbutton-handler id)
 679         (gs:save-file-dialog 'TheEditor 'savefile-action currentDir currentFile)
 680 )
 681
 682 (define (savefile-action id op file no-check)
 683         (set 'save-file-candidate file)
 684         (if file (if no-check
 685                 (writefile-prepare file)
 686                 (begin
 687                         (if (file? (base64-dec file))
 688                                 (gs:confirm-dialog 'TheEditor 'confirmsave-action "Save As ..."
 689                                         (append "Overwrite " (base64-dec file) "?") "yes-no-cancel")
 690                                 (writefile-prepare file)
 691                         )
 692                 ))
 693         )
 694 )
 695
 696 (define (confirmsave-action id result)
 697         (if (= result 0)
 698                 (writefile-prepare save-file-candidate))
 699         (if (= result 1)
 700                 (saveasbutton-handler 'FileSaveAs))
 701 )
 702
 703 (define (writefile-prepare file)
 704         (set 'currentPath (base64-dec file))
 705         (set 'currentDir (join (chop (parse currentPath {\\|/} 0)) "/" ))
 706         (set 'currentFile (last (parse currentPath {\\|/} 0)))
 707
 708         (gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
 709         (gs:set-text 'EditorTabs currentFile currentTabIndex)
 710         (gs:disable 'FileSave 'SaveButton)
 711         (gs:set-icon 'EditorTabs "/local/green10.png" currentTabIndex)
 712         (set 'edit-buffer-clean true)
 713
 714         (gs:get-text currentEdit 'writefile-action)
 715 )
 716
 717 (define (writefile-action id text)
 718         (local (bytes)
 719                 (if text
 720                         (if (= ostype "Win32")
 721                                 (set 'bytes (write-file currentPath (replace "\n" (base64-dec text) "\r\n")))
 722                                 (set 'bytes (write-file currentPath (base64-dec text)) ) ))
 723                 (save-recent-list)
 724                 (if (not bytes)
 725                         (gs:message-dialog 'TheEditor "Saving file" (append "Could not save " currentPath))
 726                         (output-monitor (string "--- " bytes " bytes saved to " currentPath " ---\n"))
 727                 )
 728         )
 729 )
 730
 731 (define (save-recent-list)
 732         (if (ref currentPath recentFiles)
 733                 (push (pop recentFiles (first (ref currentPath recentFiles))) recentFiles)
 734                 (push (list (uuid) currentPath) recentFiles))
 735         (set 'recentFiles (0 12 recentFiles))
 736         (save recentFilesPath 'recentFiles)
 737 )
 738
 739 (define (savesettings-handler)
 740         (pretty-print 256) ; force one lone line for themes
 741         (gs:get-bounds 'TheEditor)
 742         (set 'currentAppX (gs:bounds 0))
 743         (set 'currentAppY (gs:bounds 1))
 744         (set 'currentAppWidth (gs:bounds 2))
 745         (set 'currentAppHeight (gs:bounds 3))
 746         (set 'config:currentAppX currentAppX)
 747         (set 'config:currentAppY currentAppY)
 748         (set 'config:currentAppWidth currentAppWidth)
 749         (set 'config:currentAppHeight currentAppHeight)
 750         (set 'config:currentForeground currentForeground)
 751         (set 'config:currentBackground currentBackground)
 752         (set 'config:currentDir currentDir)
 753         (set 'config:currentFontName currentFontName)
 754         (set 'config:currentFontSize currentFontSize)
 755         (set 'config:currentMonitorFontSize currentMonitorFontSize)
 756         (set 'config:currentToolbarFloatable currentToolbarFloatable)
 757         (set 'config:currentTabsPosition currentTabsPosition)
 758         (set 'config:currentToolbarShow currentToolbarShow)
 759         (set 'config:currentThemeIdx currentThemeIdx)
 760         (set 'config:currentThemeHelp
 761                         {background foreground caret selection comments keywords strings numbers quoted parentheses})
 762         (set 'config:currentAltShell currentAltShell)
 763         (set 'config:currentMonitorForeground currentMonitorForeground)
 764         (set 'config:currentMonitorBackground currentMonitorBackground)
 765         (save userSettingsPath 'config)
 766         (output-monitor
 767                 (string "--- saved settings in: " userSettingsPath " ---\n"))
 768 )
 769
 770 (define (tooleditsettings-handler)
 771         (set 'currentPath userSettingsPath)
 772         (open-currentpath-in-tab)
 773 )
 774
 775 (define (opendemos-handler)
 776         (gs:open-file-dialog 'TheEditor 'openfile-action  (string newlispDir "/guiserver")
 777                 ".lsp" "newLISP files")
 778 )
 779
 780 (define (quitbutton-handler)
 781         (let (is-clean-tabs true)
 782                 (dolist (tab tabs-stack)
 783                         (if (not (tab 3 0)) (set 'is-clean-tabs nil)))
 784                 (if (and is-clean-tabs edit-buffer-clean)
 785                         (gs:confirm-dialog 'TheEditor 'quitconfirm-action
 786                                 "Quit newLISP edit" "You really want to quit?" "yes-no")
 787                         (gs:confirm-dialog 'TheEditor 'quitconfirm-action
 788                                 "Quit newLISP edit" "Quit and lose unsaved content?" "yes-no")
 789                 )
 790         )
 791 )
 792
 793 (define (quitconfirm-action id result)
 794         (if (= result 0)
 795                 (begin
 796                         ;(println "destroying shell")
 797                         (gs:destroy-shell 'OutputArea)
 798                         (exit))
 799         )
 800 )
 801
 802 (define (clearbutton-handler)
 803         (if (not edit-buffer-clean)
 804                 (gs:confirm-dialog 'TheEditor 'clearconfirm-action
 805                         "New edit" (string "Abandon unsaved content in " currentFile) "yes-no")
 806                 (clearbutton-action)
 807         )
 808 )
 809
 810 (define (clearconfirm-action id result)
 811         (if (= result 0)
 812                 (clearbutton-action))
 813 )
 814
 815 (define (clearbutton-action)
 816         (set 'currentPath (string currentDir "/" currentFile))
 817         (gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
 818         (gs:clear-text currentEdit)
 819         (gs:set-icon 'EditorTabs "/local/green10.png" currentTabIndex)
 820         (set 'edit-buffer-clean true)
 821         (gs:disable 'SaveButton 'FileSave))
 822
 823 (define (undo-handler)
 824         (gs:undo-text currentEdit ))
 825
 826 (define (redo-handler)
 827         (gs:redo-text currentEdit))
 828
 829 (define (copybutton-handler)
 830         (gs:copy-text currentEdit))
 831
 832 (define (cutbutton-handler)
 833         (gs:enable 'FileSave 'FileSaveAs 'SaveButton)
 834         (gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
 835         (set 'edit-buffer-clean nil)
 836         (gs:cut-text currentEdit)
 837         (gs:request-focus 'CutButton))
 838
 839 (define (pastebutton-handler)
 840         (paste-action))
 841
 842 (define (paste-action text)
 843         (gs:enable 'FileSave 'FileSaveAs 'SaveButton)
 844         (gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
 845         (set 'edit-buffer-clean nil)
 846         (gs:paste-text currentEdit text))
 847
 848 ;; goto line
 849
 850 (define (goto-handler)
 851         (gs:dialog 'GotoDialog 'TheEditor "Goto Line" 200 60 nil nil)
 852         (gs:set-resizable 'GotoDialog nil)
 853         (gs:set-flow-layout 'GotoDialog "center")
 854         (gs:label 'GotoTextLabel "Line:")
 855         (gs:text-field 'GotoTextField 'gotoline-action 4)
 856         (gs:button 'GotoButton 'gotogettext-action "Goto")
 857         (gs:add-to 'GotoDialog 'GotoTextLabel 'GotoTextField 'GotoButton)
 858         (gs:set-visible 'GotoDialog true)
 859 )
 860
 861 (define (gotoline-action id text)
 862         (if text
 863                 (let (line (int (base64-dec text) 0))
 864                         (gs:goto-text currentEdit line 0))      )
 865         (gs:dispose 'GotoDialog)
 866         (gs:request-focus currentEdit)
 867 )
 868
 869 (define (gotogettext-action)
 870         (gs:get-text 'GotoTextField 'gotoline-action)
 871 )
 872
 873 (define (position-handler)
 874         (gs:get-text-position currentEdit)
 875         (output-monitor (string "--- line: " (gs:text-position 0) " column: " (gs:text-position 1) " ---\n"))
 876 )
 877
 878 (define (switchwindow-handler id)
 879         (if (= id "MAIN:EditGotoEditor")
 880                 (gs:request-focus currentEdit)
 881                 (gs:request-focus 'OutputArea))
 882 )
 883
 884 ;;;;;;;;;;;;; find text ;;;;;;;;;;;;;;;
 885
 886 (define (findbutton-handler)
 887         (if findDialogOpen
 888                 (begin
 889                         (gs:request-focus 'FindTextField)
 890                         (gs:select-text 'FindTextField 0))
 891                 (openFindDialog)
 892         )
 893 )
 894
 895 (define (openFindDialog)
 896         (gs:dialog 'FindDialog 'TheEditor "Find text" 420 200 nil nil)
 897         (gs:set-resizable 'FindDialog nil)
 898         (gs:frame-closed 'FindDialog 'finddialogclose-handler)
 899         (gs:set-grid-layout 'FindDialog 4 1)
 900
 901         (gs:panel 'FindPanel)
 902         (gs:label 'FindTextLabel "Find:")
 903         (gs:text-field 'FindTextField 'findtextnext-action 24)
 904         (gs:add-to 'FindPanel 'FindTextLabel 'FindTextField)
 905
 906         (gs:panel 'ReplacePanel)
 907         (gs:label 'FindReplaceLabel "Replace:")
 908         (gs:text-field 'FindReplaceField 'findtextnext-action 24)
 909         (gs:add-to 'ReplacePanel 'FindReplaceLabel 'FindReplaceField)
 910         (if (not (null? currentSearchText)) (gs:set-text 'FindTextField currentSearchText))
 911         (if (not (null? currentReplaceText)) (gs:set-text 'FindReplaceField currentReplaceText))
 912
 913         (gs:panel 'ButtonPanel-1)
 914         (gs:button 'FindTextPreviousButton 'findtextprevious-action "Previous")
 915         (gs:button 'FindTextNextButton 'findtextnext-action "Next")
 916         (gs:button 'FindTextReplaceButton 'findtextreplace-action "Replace")
 917         (gs:add-to 'ButtonPanel-1 'FindTextPreviousButton 'FindTextNextButton 'FindTextReplaceButton)
 918         (gs:panel 'ButtonPanel-2)
 919         (gs:button 'FindTextReplaceNextButton 'findtextreplacenext-action "Replace and Next")
 920         (gs:button 'FindTextUndoPrevButton 'findtextundoprev-action "Undo Previous")
 921         (gs:add-to 'ButtonPanel-2 'FindTextReplaceNextButton 'FindTextUndoPrevButton)
 922
 923         (gs:set-tool-tip 'FindTextPreviousButton "Find previous occurrence of the find text")
 924         (gs:set-tool-tip 'FindTextNextButton "Find next occurrence of the find text")
 925         (gs:set-tool-tip 'FindTextReplaceButton "Replace selected text with replacement text")
 926         (gs:set-tool-tip 'FindTextReplaceNextButton "Replace next occurence")
 927         (gs:set-tool-tip 'FindTextUndoPrevButton "Undo previous replacement")
 928
 929         (gs:add-to 'FindDialog 'FindPanel 'ReplacePanel 'ButtonPanel-1 'ButtonPanel-2)
 930         (gs:set-visible 'FindDialog true)
 931         (gs:disable 'FindTextReplaceButton 'FindTextReplaceNextButton 'FindTextUndoPrevButton)
 932         (gs:enable 'EditFindPrevious 'EditFindNext 'EditReplace 'EditFindDispose)
 933         (gs:select-text 'FindTextField 0)
 934         (set 'findDialogOpen true)
 935 )
 936
 937 (define (finddispose-handler)
 938         (gs:dispose 'FindDialog)
 939         (gs:disable 'EditFindDispose)
 940         (set 'findDialogOpen nil)
 941 )
 942
 943 (define (finddialogclose-handler id)
 944         (gs:enable 'FindButton 'EditFind)
 945         (gs:disable 'EditFindDispose)
 946         (set 'findDialogOpen nil)
 947 )
 948
 949 (define (findtextcheckbox-action id flag)
 950         (println id " " flag)
 951 )
 952
 953 ;; find next, this handler is enterd first by all
 954 ;; FindDialog events, text-field(s) and button(s)
 955
 956 (define (findtextnext-action id text)
 957         (if (and (or (= id "MAIN:FindTextField") (= id "MAIN:FindReplaceField")) (not text))
 958                 (finddispose-handler) ; ESC key was pressed
 959                 (begin
 960                         (set 'currentSearchDirection "next")
 961                         (gs:get-text 'FindTextField 'getfindtext-action)
 962                 )
 963         )
 964 )
 965
 966 ;; find previous
 967
 968 (define (findtextprevious-action)
 969         (set 'currentSearchDirection "previous")
 970         (gs:get-text 'FindTextField 'getfindtext-action)
 971 )
 972
 973
 974 ;; retrieve search field text
 975
 976 (define (getfindtext-action id text)
 977         (if text
 978                 (begin
 979                         (set 'currentSearchText (base64-dec text))
 980                         (gs:get-text 'FindReplaceField 'getreplacetext-action)
 981                 )
 982                 (gs:request-focus currentEdit)
 983         )
 984 )
 985
 986 ;; rertrieve replace field text
 987
 988 (define (getreplacetext-action id text)
 989         (set 'currentReplaceText (if text (base64-dec text) ""))
 990         (if (not (null? currentSearchText))
 991                 (gs:find-text currentEdit currentSearchText 'findtextresult-action currentSearchDirection))
 992 )
 993
 994 (define (findtextresult-action id result)
 995         (if (= result -1)
 996                 (begin
 997                         (gs:set-text 'FindDialog "Not found")
 998                         (gs:disable 'FindTextReplaceNextButton)
 999                         (when (and (= currentDot currentMark) (= currentSearchDirection "next"))
1000                                 (set 'currentMark (inc 'currentDot))
1001                                 (gs:set-caret currentEdit currentMark)
1002                         )
1003                 )
1004                 (begin
1005                         (gs:set-text 'FindDialog "Find text")
1006                         (gs:enable 'FindTextReplaceButton 'FindTextReplaceNextButton)
1007                         (gs:request-focus currentEdit)
1008                 )
1009         )
1010 )
1011
1012 ;; replace
1013
1014 (define (findtextreplace-action)
1015         (gs:undo-enable currentEdit nil)
1016         (if (!= currentMark currentDot)
1017                 (gs:paste-text currentEdit currentReplaceText))
1018         ;(gs:request-focus currentEdit)
1019         (gs:disable 'FindTextReplaceButton 'FindTextReplaceNextButton)
1020         (gs:enable 'FindTextUndoPrevButton)
1021         (gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
1022         (set 'edit-buffer-clean nil)
1023         (gs:enable 'FileSave 'FileSaveAs 'SaveButton 'EditUndo)
1024         (gs:undo-enable currentEdit true)
1025 )
1026
1027 ;; replace and next
1028
1029 (define (findtextreplacenext-action)
1030         (gs:undo-enable currentEdit nil)
1031         (gs:paste-text currentEdit currentReplaceText)
1032         (gs:disable 'FindTextReplaceButton)
1033         (gs:enable 'FindTextReplaceNextButton 'FindTextUndoPrevButton)
1034         (gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
1035         (set 'edit-buffer-clean nil)
1036         (gs:enable 'FileSave 'FileSaveAs 'SaveButton 'EditUndo)
1037         (set 'currentSearchDirection "next")
1038         (gs:get-text 'FindTextField 'getfindtext-action)
1039         (gs:undo-enable currentEdit true)
1040 )
1041
1042 ; previous and undo
1043 (define (findtextundoprev-action)
1044         (gs:undo-enable currentEdit nil)
1045         (gs:find-text currentEdit currentReplaceText 'findpreviousresult-action "previous")
1046         (gs:undo-enable currentEdit true)
1047 )
1048
1049 (define (findpreviousresult-action id result)
1050         (if (= result -1)
1051                 (begin
1052                         (gs:set-text 'FindDialog "Not found for undo")
1053                         (gs:disable 'FindTextUndoPrevButton 'FindTextReplaceButton 'FindTextReplaceNextButton)
1054                 )
1055                 (begin
1056                         (gs:paste-text currentEdit currentSearchText)
1057                         (gs:request-focus currentEdit)
1058                 )
1059         )
1060 )
1061
1062 ;; view menu fonts bigger/smaller handlers
1063
1064 (define (viewfontsmaller-handler)
1065         (dec 'currentFontSize)
1066         (gs:set-text 'FontSizeLabel (string currentFontSize))
1067         (gs:set-font currentEdit currentFontName currentFontSize "plain"))
1068
1069 (define (viewfontbigger-handler)
1070         (inc 'currentFontSize)
1071         (gs:set-text 'FontSizeLabel (string currentFontSize))
1072         (gs:set-font currentEdit currentFontName currentFontSize "plain"))
1073
1074 ;;
1075
1076 (define (fontbookbutton-handler)
1077         (gs:dialog 'FontBookSelection 'TheEditor "Click on a font name to select it" 300 200 nil nil)
1078         (gs:set-background 'FontBookSelection 1 1 1)
1079         (gs:get-fonts)
1080         (gs:panel 'FontPanel)
1081         (gs:set-grid-layout 'FontPanel (length gs:fonts) 1 0 0)
1082         (dolist (font gs:fonts)
1083                 (set 'font-label (string "label-" $idx))
1084                 (gs:label font-label font)
1085                 (if (= font currentFontName)
1086                         (gs:set-foreground font-label 0.8 0.5 0.0))
1087                 (gs:set-size font-label 100 30)
1088                 (gs:set-font font-label font 24 "plain")
1089                 (gs:mouse-event font-label 'mouse-action)
1090                 (gs:add-to 'FontPanel font-label))
1091
1092         (gs:scroll-pane 'Scroll 'FontPanel)
1093         (gs:add-to 'FontBookSelection 'Scroll)
1094         (gs:set-visible 'FontBookSelection true)
1095 )
1096
1097 ;; handle mouse clicks in font book
1098 (define (mouse-action id type x y button cnt mods)
1099         (if (= type "pressed")
1100                 (gs:set-foreground id 0.8 0.5 0.0)
1101                 (begin
1102                         (set 'currentFontName (gs:fonts (int (last (parse id "-")) 0)))
1103                         (gs:set-font currentEdit currentFontName currentFontSize "plain")
1104                         (gs:set-foreground id 0 0 0))
1105         )
1106 )
1107
1108 ;; font panel mouse click handler
1109
1110 (define (fontpanel-event id  type x y button cnt modifiers)
1111         (if (= type "clicked")
1112                 (case id
1113                         ("MAIN:FontBiggerLabel" (viewfontbigger-handler))
1114                         ("MAIN:FontSmallerLabel" (viewfontsmaller-handler))
1115                 )
1116         )
1117 )
1118
1119 ;; initialize syntax for first tab
1120 (theme-handler (string "ViewTheme" currentThemeIdx))
1121 ;;;;;;;;;;;; exec  newlisp over editor contents ;;;;;;;;;;
1122
1123 (define (process-or-execbutton-handler)
1124         (if (not (directory? $TEMP))
1125                 (gs:message-dialog 'TheEditor "Cannot find temporal directory"
1126                                 (append "Need to create a directory " $TEMP) "information")
1127                 (begin
1128                         (disable-main-tools)
1129 ;                       (gs:get-text currentEdit 'exec-handler)
1130                         (gs:get-text currentEdit 'auxiliary-process-handler)
1131                         (gs:enable 'ViewClearMonitor)
1132                 )
1133         )
1134 )
1135
1136 ; evaluates content of editor area in the auxiliary newLISP
1137 ; process, as output is generated it is displayed in the
1138 ; monitor area
1139 (define (auxiliary-process-handler id text)
1140         (if text
1141                 (begin
1142                         (set 'text (base64-dec text))
1143                         (write-file "editor.txt" text)
1144                         (gs:eval-shell 'OutputArea (string "[cmd]\n" text "\n[/cmd]\n"))))
1145         (after-exec-or-process)
1146 )
1147
1148 ; after the exec or auxiliary process execution
1149 ; enable buttons, menus and edit area
1150 (define (after-exec-or-process)
1151         (gs:enable 'FileMenu 'EditMenu 'ViewMenu 'RunMenu)
1152         (gs:enable 'NewButton 'ClearButton 'PasteButton
1153                                 'LoadButton 'ExecButton 'RestartButton 'FindButton 'FontBookButton)
1154         (gs:set-editable  currentEdit true)
1155         (if (not edit-buffer-clean) (gs:enable 'SaveButton))
1156         (gs:request-focus currentEdit)
1157         (gs:select-text currentEdit currentDot currentMark)
1158         (if is-selection
1159                 (gs:enable 'CutButton 'CopyButton))
1160 )
1161
1162 ; disable main menus and toolbar
1163 (define (disable-main-tools)
1164                 (gs:disable 'FileMenu 'EditMenu 'ViewMenu 'RunMenu)
1165                 (gs:disable 'NewButton 'ClearButton 'LoadButton 'SaveButton
1166                                 'CutButton 'CopyButton 'PasteButton
1167                                 'ExecButton 'RestartButton 'FindButton 'FontBookButton)
1168                 (gs:set-editable  currentEdit nil)
1169 )
1170
1171 ;;;;;;;;;;;;;;;;;;;;;;;; end auxiliary process handling ;;;;;;;;;;;;;;;;;;;;;;;
1172
1173 ;; clear bottom monitor area
1174 (define (viewclearmonitor-handler)
1175         (gs:clear-text 'OutputArea)
1176         ;(gs:disable 'ViewClearMonitor)
1177 )
1178
1179 ;; output to monitor area
1180 (define (output-monitor str)
1181         (gs:append-text 'OutputArea str)
1182         (gs:enable 'ViewClearMonitor)
1183 )
1184
1185 ;; dtach/attach toolbar
1186 (define (viewtoolbar-handler id flag)
1187         (if flag
1188                 (begin
1189                         (set 'currentToolbarShow "yes")
1190                         (gs:add-to 'TheEditor 'ToolBar "north")
1191                         ; if the toolbar was not visible on startup
1192                         ; it will not be visible now, inspite of layout
1193                         ; this forces components of the container to be redrawn
1194                         (gs:set-visible 'TheEditor true)
1195                         (gs:layout 'TheEditor)
1196                 )
1197                 (begin
1198                         (set 'currentToolbarShow "no")
1199                         (gs:remove-from 'TheEditor 'ToolBar)
1200                         (gs:layout 'TheEditor)
1201                 )
1202         )
1203 )
1204
1205 ;; syntax highlighting and themes 1,2,3
1206 ;; for menu-item theme-handler function
1207 ;; see beginning of file
1208
1209 (define (viewsyntax-handler id flag)
1210         (if flag
1211                 (begin
1212                         (set 'currentSyntaxStatus (current-file-syntax))
1213                         (if (not currentSyntaxStatus)
1214                                         (begin
1215                                                 (gs:set-selected 'ViewSyntax nil)
1216                                                 (gs:show-popup 'SyntaxMenu 'TheEditor 100 100))
1217                                         (gs:set-syntax currentEdit currentSyntaxStatus)))
1218                 (begin
1219                         (set 'currentSyntaxStatus nil)
1220                         (gs:set-syntax currentEdit nil))
1221         )
1222 )
1223
1224 (define (syntaxmenu-handler id idx)
1225         (gs:set-syntax currentEdit (set 'currentSyntaxStatus
1226                 (case id
1227                         ("MAIN:SyntaxNewlisp" "lsp")
1228                         ("MAIN:SyntaxC" "c")
1229                         ("MAIN:SyntaxCPP" "cpp")
1230                         ("MAIN:SyntaxJava" "java")
1231                         ("MAIN:SyntaxPHP" "php")
1232                 ))
1233         )
1234         (gs:set-selected 'ViewSyntax (true? currentSyntaxStatus))
1235 )
1236
1237 ;; handle character and caret events from edit area
1238 (define (editarea-handler id code mods dot mark len undo redo)
1239         (if undo (gs:enable 'EditUndo) (gs:disable 'EditUndo))
1240         (if redo (gs:enable 'EditRedo) (gs:disable 'EditRedo))
1241         (set 'currentDot dot 'currentMark mark)
1242 ;       (println code ":" mods)
1243         (if (= code 65535) ; crtl or meta keys wit or w/o shift
1244                 ; caret movement only
1245                 (if (not is-selection)
1246                         (if (!= dot mark) ; selection started
1247                                 (begin
1248                                         (gs:enable 'CutButton 'CopyButton 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
1249                                         (set 'is-selection true)))
1250                         (if (= dot mark)  ; de-selected
1251                                 (begin
1252                                         (gs:disable 'CutButton 'CopyButton 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
1253                                         (set 'is-selection nil)))
1254                 )
1255                 ; character typed
1256                 (if edit-buffer-clean
1257                         (begin
1258                                 (set 'edit-buffer-clean nil)
1259                                 (gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
1260                                 (gs:enable 'FileSave 'FileSaveAs 'SaveButton)
1261                         )
1262                 )
1263         )
1264 )
1265
1266 ;; handle mouse clicks from editeara for popup menu
1267 (define (editarea-mouse-handler id type x y button cnt modifiers)
1268         (if (or (= button 3) (= modifiers 18)); right button or ctrl click
1269                 (gs:show-popup 'EditMenuPopup currentEdit x y)
1270         )
1271 )
1272
1273 ;; tabs have switched or a new tab has been inserted
1274 (define (editortabs-handler id tab title idx)
1275         (update-current-tab)
1276         (set 'currentTabIndex idx)
1277         ; get new tab edit area settings
1278         (set 'currentEdit tab)
1279         (switch-to-tab tab idx)
1280 )
1281
1282 (define (switch-to-tab tab)
1283         (set 'currentDir (lookup currentEdit tabs-stack 1))
1284         (set 'currentFile (lookup currentEdit tabs-stack 2))
1285         (set 'currentPath (string currentDir "/" currentFile))
1286         (set 'currentStatus (lookup currentEdit tabs-stack 3))
1287         (set 'edit-buffer-clean (currentStatus 0))
1288         (if edit-buffer-clean
1289                 (begin
1290                         (gs:set-icon 'EditorTabs "/local/green10.png" currentTabIndex)
1291                         (gs:disable 'FileSave 'SaveButton)
1292                 )
1293                 (begin
1294                         (gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
1295                         (gs:enable 'FileSave 'SaveButton)
1296                 )
1297         )
1298         (set 'currentDot (currentStatus 1))
1299         (set 'currentMark (currentStatus 2))
1300         (set 'currentSyntaxStatus (currentStatus 3))
1301         (if (= currentDot currentMark)
1302                 (begin
1303                         (set 'is-selection nil)
1304                         (gs:disable 'CutButton 'CopyButton 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
1305                         (gs:request-focus currentEdit) )
1306                 (begin
1307                         (set 'is-selection true)
1308                         (gs:enable 'CutButton 'CopyButton 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
1309                         (gs:request-focus currentEdit)
1310                         (gs:select-text currentEdit currentDot currentMark) )
1311         )
1312         (gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
1313         (theme-handler (string "ViewTheme" currentThemeIdx))
1314 )
1315
1316 (define (update-current-tab)
1317         (set 'currentStatus (list edit-buffer-clean currentDot currentMark currentSyntaxStatus))
1318         ; save previous tab edit area settings
1319         (replace-assoc currentEdit tabs-stack (list currentEdit currentDir currentFile currentStatus))
1320 )
1321
1322 ;; help about box
1323 ;; on Mac OS X the built-in about box is shown (contained in guiserver.jar)
1324 ;; selectable from the Apple system menu
1325 ;; On other OSs the Help menu contains the following (identical loooking)
1326 ;; about box
1327
1328 (define (helpabout-handler)
1329         (if (!= ostype "OSX")
1330                 (begin
1331                         (gs:get-version)
1332                         (gs:message-dialog 'TheEditor (string "newLISP-GS v." gs:version)
1333                                 (string "Software: copyright (c) 2007 Lutz Mueller http://newlisp.org\n"
1334                                                 "Icons: copyright (c) 2007 Michael Michaels http://neglook.com\n"
1335                                                 "All rights reserved.")
1336                                 "information" "/local/newLISP64.png" )
1337                 )
1338         )
1339 )
1340
1341 ;; show newLISP Users Manual and Reference
1342
1343 (define (helpmanual-handler)
1344         (load-platform-help "/manual_frame.html")
1345 )
1346
1347 ;; show GS Manual
1348
1349 (define (helpguiserver-handler)
1350         (load-platform-help "/guiserver/index.html")
1351 )
1352
1353 (define (load-platform-help file-name , prog files)
1354         (if (not (file? (string newlispDoc file-name)))
1355                 (gs:message-dialog 'TheEditor "Display documentation"
1356                                 (string "Cannot find file: " newlispDoc file-name)
1357                 "warning"))
1358         (cond
1359                 ; Mac OS X
1360                 ((= ostype "OSX")
1361                         (exec (string "open file://" newlispDoc file-name))
1362                 )
1363                 ; Windows, loading docs from the menu has been disabled because open explorer blocks the Java part
1364                 ; of newlisp-edit.lsp from exiting
1365                 ((= ostype "Win32")
1366                         (begin
1367                                 (set 'prog (string "cmd /c \"" (env "PROGRAMFILES") "/Internet Explorer/IEXPLORE.EXE\""))
1368                                 ;(println "->" prog "<-")
1369                                 (exec (string prog " file://" newlispDoc file-name)))
1370                 )
1371                 ; all other UNIX
1372                 (true
1373                         (set 'files '(
1374                                         "/usr/bin/sensible-browser"
1375                                         "/usr/bin/x-www-browser"
1376                                         "/usr/bin/mozilla"
1377                                         "/usr/bin/konqueror"))
1378                         (set 'prog (find true (map file? files)))
1379                         (if prog
1380                                 (exec (string (files prog) " file://" newlispDoc file-name))
1381                                 (gs:message-dialog 'TheEditor "Display documentation"
1382                                                 "Cannot find browser to display documentation" "warning")
1383                         )
1384                 )
1385         )
1386 )
1387
1388
1389 ;; start listening for GUI events and output from auxiliary newLISP process
1390 ;; append out put from newLISP process to monitor area
1391
1392 (while (gs:check-event 10000)
1393         (if (and console (net-select console "read" 10000))
1394                 (begin
1395                         (if (> (net-peek console) 0) (begin
1396                                 (net-receive console 'response 10024)
1397                                 (output-monitor (or response ""))
1398                                 (sleep 100)
1399                                 ))
1400                         (check-status)
1401                 )
1402         )
1403 )
1404
1405 ;; eof