#!/usr/bin/newlisp

; newlisp-edit.lsp - multiple tab LISP editor and support for running code from the editor

; version 1.10

;(set 'debug-on true) ; special debug for aux communications

(set-locale "C")

;;;; initialization
(set 'newlispDir (env "NEWLISPDIR"))

(set 'newlispDoc (if (= ostype "Win32") 
	newlispDir "/usr/share/doc/newlisp"))

(load (string newlispDir "/guiserver.lsp"))

(constant (global '$HOME) (or (env "HOME") (env "USERPROFILE") (env "DOCUMENT_ROOT") ""))
(constant '$TEMP (if (= ostype "Win32") (or (env "TEMP") "C:\\temp") "/tmp"))

(if (= ostype "Win32")
	(begin
		(set 'userSettingsDir (string
			(or (env "APPDATA") (env "HOME") (env "USERPROFILE") (env "DOCUMENT_ROOT")) "/newLISP"))
		(set 'userSettingsPath (append userSettingsDir "/newlisp-edit.config"))
		(set 'recentFilesPath (append userSettingsDir "/newlisp-edit-recent"))
		(if (not (directory userSettingsDir)) (make-dir userSettingsDir))
	)
	(begin
		(set 'userSettingsPath (append $HOME "/.newlisp-edit.conf"))
		(set 'recentFilesPath (append $HOME "/.newlisp-edit-recent"))
	)
)

;; init guiserver

(gs:init) 
;(gs:set-trace true)


;; create default user settings

(gs:get-screen)
(set 'config:currentAppWidth 800)
(set 'config:currentAppHeight (- (gs:screen 1) 80))
(set 'config:currentAppX (/ (- (gs:screen 0) config:currentAppWidth) 3))
(set 'config:currentAppY (/ (- (gs:screen 1) config:currentAppHeight) 2))
(set 'config:currentForeground '(0.0 0.0 0.2))
(set 'config:currentBackground '(1.0 1.0 1.0))
(set 'config:currentDir $HOME)
(set 'config:currentFontName (if (= ostype "Win32") "Monospaced" "Lucida Sans Typewriter"))
(set 'config:currentFontSize (if (= ostype "Win32") 14 13))
(set 'config:currentMonitorFontSize (if (= ostype "Win32") 14 13))
(set 'config:currentToolbarFloatable "no")
(set 'config:currentTabsize 16)
(set 'config:currentTabsPosition "top")
(set 'config:currentToolbarShow "yes")
(set 'config:currentThemeIdx 0)
(set 'config:currentAltShell "")
(set 'config:currentMonitorForeground '(0.1 0.1 0.5))
(set 'config:currentMonitorBackground '(0.95 0.95 0.95))

;; configure themes

; background, foreground, caret, selection
; comments, keywords, strings
; numebers, quoted, parentheses

(set 'config:currentThemes '(
	("Mozart" (1 1 1) (0 0 0) (0.5 0.5 0.8) (0.7 0.7 1.0)
		(0.5 0.5 0.5) (0 0 0.75)	(0 0.5 0.0)	
		(0.50 0.5 0)	(0.350 0.350 0.50)	(0.50 0 0))

	("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)
		(0.5 0.5781 0.597)	(0.125 0.2031 0.332)	(0.5547 0.6562 0.6562)	
		(0.8203 0.6055 0.1953)	(0.8203 0.6055 0.1953)	(0.125 0.2031 0.332))

	("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)
		(0.6 0.6 0.6)	(0.9 0.9 0.3) (0.4 0.9 0.4) 
		(0.75 0.75 0.95) (0.5 0.5 0.9) (1.0 0.3 0.3))
))

;; initialize script list
(set 'config:currentScripts 
	(list 
		(list "Word count" (string newlispDir "/guiserver/word-count.lsp") "content")
		(list "Uppercase" (string newlispDir "/guiserver/uppercase.lsp") "selection" "F4")
))

;; menu-item handler for themes
(define (theme-handler id)
  ; extract theme index from id string and extract theme from list
	(letn ( (idx (int (9 id))) (T (config:currentThemes idx)) )
		(gs:set-background currentEdit (T 1))
		(set 'currentBackground (T 1))
		(gs:set-foreground currentEdit (T 2))
		(set 'currentForeground (T 2))
		(gs:set-caret-color currentEdit (T 3))
		(gs:set-selection-color currentEdit (T 4))
		(gs:set-syntax-colors (T 5) (T 6) (T 7) (T 8) (T 9) (T 10))
		(gs:set-syntax currentEdit currentSyntaxStatus)
		(gs:set-selected 'ViewSyntax (true? currentSyntaxStatus))
		(set 'currentThemeIdx idx)
		(dotimes (i (length config:currentThemes))
			(gs:enable (string "ViewTheme" i)))
		(gs:disable (string "ViewTheme" idx))
	)
)

(define (current-file-syntax)
	(cond
		((ends-with currentFile ".lsp") "lsp")
		((ends-with currentFile ".c") "c")
		((ends-with currentFile ".cpp") "cpp")
		((ends-with currentFile ".h") "cpp")
		((ends-with currentFile ".java") "java")
		((ends-with currentFile ".php") "php")
		(true nil)
	)
)

;; script-handler, saves current edit tab to a temporary file
;; and passes the file name as an argument to the script
;; scripts are registered in the settings file
;; scripts must exit or newlisp-edit will hang.
(define (script-handler id)
	(letn ( (idx (int (10 id))) (S (config:currentScripts idx)))
		(set 'currentScriptFile (S 1))
		(if (file? currentScriptFile)
			(begin
				(set 'currentScriptMode (S 2))
				(if (= currentScriptMode "selection")
					(gs:get-selected-text currentEdit 'script-execute)
				; else "content"
    			(gs:get-text currentEdit 'script-execute))
			)
			(output-monitor (string "--- could not find script " currentScriptFile " ---\n"))
		)
	)
)

(define (script-execute id text)
	(if (not text) (set 'text "===="))
	(let (file (string $TEMP "/" (uuid)))
		(if (= ostype "Win32")
			(write-file file (replace "\n" (base64-dec text) "\r\n"))
			(write-file file (base64-dec text)))
		(if (= ostype "Win32")
			(catch (exec (string {newlisp.exe "} currentScriptFile {" } file " > " (string file "out"))) 'result)
			(catch (exec (string "/usr/bin/newlisp " currentScriptFile " " file)) 'result)
		)
		(if (list? result)
			(begin
				(set 'result (if (= ostype "Win32")
					(read-file (string file "out"))
 					(join result "\n")))
				(if (= currentScriptMode "selection")
					(paste-action result)
					(if (= ostype "Win32")
						(output-monitor result)
						(output-monitor (string result "\n")))
				)
			)
			(output-monitor result)
		)
		(if (= ostype "Win32") (delete-file (string file "out")))
		(delete-file file)
	)
)



;; if newlisp-edit.config exists load user-settings
(if (file? userSettingsPath) 
	(if (not (catch (load userSettingsPath) 'result))
		(set 'loadUserSettingsError result))
	(if (not (catch (save userSettingsPath 'config) 'result))
		(set 'loadUserSettingsError result))
)

(if (not	(catch (load recentFilesPath) 'result))
	(set 'recentFiles '()))

(set 'currentAppX config:currentAppX)
(set 'currentAppY config:currentAppY)
(set 'currentAppWidth config:currentAppWidth)
(set 'currentAppHeight config:currentAppHeight)
(set 'currentForeground config:currentForeground)
(set 'currentBackground config:currentBackground)
(set 'currentDir config:currentDir)
(set 'currentFile "Untitled.lsp")
(set 'currentFontName config:currentFontName)
(set 'currentFontSize config:currentFontSize)
(set 'currentMonitorFontSize config:currentMonitorFontSize)
(set 'currentToolbarFloatable config:currentToolbarFloatable)
(set 'currentTabsPosition config:currentTabsPosition)
(set 'currentToolbarShow config:currentToolbarShow)
(set 'currentThemeIdx config:currentThemeIdx)
(set 'currentAltShell config:currentAltShell)
(set 'currentMonitorForeground config:currentMonitorForeground)
(set 'currentMonitorBackground config:currentMonitorBackground)

(set 'currentPath (string currentDir "/" currentFile))
(set 'currentSyntaxStatus "lsp")


;(gs:set-look-and-feel "com.sun.java.swing.plaf.motif.MotifLookAndFeel")
;(gs:set-look-and-feel "javax.swing.plaf.metal.MetalLookAndFeel")
;(gs:set-look-and-feel "com.sun.java.swing.plaf.windows.WindowsLookAndFeel")
;(gs:set-look-and-feel "javax.swing.plaf.mac.MacLookAndFeel")
;(gs:set-look-and-feel "com.sun.java.swing.plaf.gtk.GTKLookAndFeel")

(define (start-newlisp-shell)
	(if (= ostype "Win32")
		(gs:run-shell 'OutputArea (string newlispDir "/newlisp.exe -C -w " $HOME))
		(gs:run-shell 'OutputArea (string "/usr/bin/newlisp -C -w " $HOME))
	)
)

(define (startshell-handler)
	(gs:run-shell 'OutputArea currentAltShell)
)

;;;; describe the GUI ;;;;;;;;;;;;;;;;;;;;;;;

(gs:frame 'TheEditor currentAppX currentAppY currentAppWidth currentAppHeight "newLISP edit")
(gs:frame-closed 'TheEditor 'quitbutton-handler)

(set 'default-currentFontName currentFontName)

(gs:set-border-layout 'TheEditor 0 0)
(gs:tool-bar 'ToolBar (= currentToolbarFloatable "yes"))
(gs:set-flow-layout 'ToolBar "left" 18 5)
(gs:image-button 'NewButton 'newbutton-handler "/local/new32.png" "/local/new-down32.png")
(gs:image-button 'ClearButton 'clearbutton-handler "/local/clear32.png" "/local/clear-down32.png")
(gs:image-button 'LoadButton 'loadbutton-handler "/local/folder-opened32.png" "/local/folder-opened-down32.png")
(gs:image-button 'SaveButton 'savebutton-handler "/local/save32.png" "/local/save-down32.png")
(gs:image-button 'CutButton 'cutbutton-handler "/local/cut32.png" "/local/cut-down32.png")
(gs:image-button 'CopyButton 'copybutton-handler "/local/copy32.png" "/local/copy-down32.png")
(gs:image-button 'PasteButton 'pastebutton-handler "/local/paste32.png" "/local/paste-down32.png")
(gs:image-button 'FindButton 'findbutton-handler "/local/search32.png" "/local/search-down32.png")
(gs:image-button 'ExecButton 'process-or-execbutton-handler "/local/run32.png" "/local/run-down32.png")
(gs:image-button 'RestartButton 'start-newlisp-shell "/local/restart32.png" "/local/restart-down32.png")
(gs:image-button 'FontBookButton 'fontbookbutton-handler "/local/font-book32.png" "/local/font-book-down32.png")
(gs:set-tool-tip 'NewButton "Open a new tab")
(gs:set-tool-tip 'LoadButton  "Load file into editor")
(gs:set-tool-tip 'SaveButton "Save file in editor")
(gs:set-tool-tip 'ClearButton "Clear editor panel")
(gs:set-tool-tip 'CutButton "Cut selection to clipboard")
(gs:set-tool-tip 'CopyButton "Copy selection to clipboard")
(gs:set-tool-tip 'PasteButton "Paste from clipboard")
(gs:set-tool-tip 'FindButton "Find")

(gs:set-tool-tip 'ExecButton "Run editor content")
(gs:set-tool-tip 'RestartButton "Restart auxiliary newLISP process")
(gs:set-tool-tip 'FontBookButton "Select editor font")

(gs:add-to 'ToolBar 'NewButton 'LoadButton 'SaveButton)
(gs:add-separator 'ToolBar)
(gs:add-to 'ToolBar 'ClearButton 'CutButton 'CopyButton 'PasteButton)
(gs:add-separator 'ToolBar)
(gs:add-to 'ToolBar 'FindButton)
(gs:add-separator 'ToolBar)
(gs:add-to 'ToolBar 'ExecButton 'RestartButton)
(gs:add-separator 'ToolBar)
(gs:add-to 'ToolBar 'FontBookButton)

(gs:panel 'FontPanel 46 18)
(gs:set-grid-layout 'FontPanel 1 3)
(gs:label 'FontSmallerLabel "A" "center")
(gs:label 'FontSizeLabel (string currentFontSize) "center")
(gs:label 'FontBiggerLabel "A" "center")
(gs:set-tool-tip 'FontSizeLabel "Font size" "right")
(gs:set-font 'FontSmallerLabel "Lucida Sans Regular" 10 "italic")
(gs:set-font 'FontSizeLabel "Lucida Sans Regular" 10 "plain")
(gs:set-font 'FontBiggerLabel "Lucida Sans Regular" 13 "italic")
(gs:add-to 'FontPanel 'FontSmallerLabel 'FontSizeLabel 'FontBiggerLabel)

(gs:add-to 'ToolBar 'FontPanel)

(gs:mouse-event 'FontBiggerLabel 'fontpanel-event)
(gs:mouse-event 'FontSmallerLabel 'fontpanel-event)

(gs:set-tool-tip 'FontBiggerLabel "Bigger font")
(gs:set-tool-tip 'FontSmallerLabel "Smaller font")

;; disable Cut- and Copy- buttons until selection is make
;; SaveButton util content in EditArea
(gs:disable 'CutButton 'CopyButton 'SaveButton)

(if (= currentToolbarShow "yes")
	(gs:add-to 'TheEditor 'ToolBar "north"))

(set 'tabs-stack '())

;; configure text area
(define (make-editor-tab dir file-name)
	(let (edit-tab (append "tab-" (uuid)) )
		(push (list edit-tab dir file-name (list true 0 0)) tabs-stack -1)
		(gs:text-pane edit-tab 'editarea-handler "text/plain")
		(gs:mouse-event edit-tab 'editarea-mouse-handler)
		(gs:set-foreground edit-tab currentForeground)
		(gs:set-background edit-tab currentBackground) 
		(gs:set-tab-size edit-tab config:currentTabsize)
		(gs:set-font edit-tab currentFontName currentFontSize "plain")
	edit-tab)
)

(set 'currentDot 0 'currentMark 0)
(set 'edit-buffer-clean true)
(set 'currentEdit (make-editor-tab currentDir currentFile))
(gs:set-syntax currentEdit (ends-with currentFile ".lsp"))
(set 'currentTabIndex 0)
(gs:set-text 'TheEditor (string "newLISP edit - " currentPath))

(set 'editUndoCount 0)

(gs:tabbed-pane 'EditorTabs 'editortabs-handler currentTabsPosition
	currentEdit "Untitled.lsp")

(gs:set-icon 'EditorTabs "/local/green10.png" currentTabIndex)

; configure output area
(gs:text-area 'OutputArea 'gs:no-action)
(gs:set-background 'OutputArea currentMonitorBackground)
(gs:set-foreground 'OutputArea currentMonitorForeground)
(gs:set-font 'OutputArea "Monospaced" currentMonitorFontSize "plain")
(gs:split-pane 'TextPanel "horizontal" 0.70 0.5 5)
(gs:add-to 'TextPanel 'EditorTabs 'OutputArea)
(gs:add-to 'TheEditor  'TextPanel "center")

;; configure main menu
(gs:menu 'FileMenu "File")
(gs:menu-item 'FileClear 'clearbutton-handler "Clear tab" true)
(gs:menu-item 'FileNew 'newbutton-handler "New tab")
(gs:menu-item 'FileOpen 'loadbutton-handler "Open ...")
(gs:menu-item 'FileClose 'fileclose-handler "Close tab")
(gs:menu-item 'FileSave 'savebutton-handler "Save")
(gs:menu-item 'FileSaveAs 'saveasbutton-handler "Save As ...")
(gs:menu-item 'FileSettings 'savesettings-handler "Save Settings")
(gs:menu-item 'FileQuit 'quitbutton-handler (if (= ostype "Win32") "Exit" "Quit"))

(gs:menu 'FileRecent "Recent Files")


(if recentFiles (dolist (f recentFiles)
	(if (file? (f 1))
		(begin
			(gs:menu-item (f 0) 'recentfiles-handler (f 1))
			(gs:add-to 'FileRecent (f 0)))
		(replace f recentFiles))
))

(gs:menu 'EditMenu "Edit")
(gs:menu-item 'EditUndo 'undo-handler "Undo")
(gs:menu-item 'EditRedo 'redo-handler "Redo")
(gs:menu-item 'EditCut 'cutbutton-handler "Cut")
(gs:menu-item 'EditCopy 'copybutton-handler "Copy")
(gs:menu-item 'EditPaste 'pastebutton-handler "Paste")
(gs:menu-item 'EditGoto 'goto-handler "Goto Line")
(gs:menu-item 'EditPosition 'position-handler "Get Position")
(gs:menu-item 'EditGotoEditor 'switchwindow-handler "Goto Editor")
(gs:menu-item 'EditGotoShell 'switchwindow-handler "Goto Shell")
(gs:menu-item 'EditFind 'findbutton-handler "Find")
(gs:menu-item 'EditFindNext 'findtextnext-action "Find next")
(gs:menu-item 'EditFindPrevious 'findtextprevious-action "Find Previous")
(gs:menu-item 'EditReplace 'findtextreplace-action "Replace Selection")
;(gs:menu-item 'EditReplaceNext 'findtextreplace-action "Replace Next")
(gs:menu-item 'EditFindDispose 'finddispose-handler "Find Dispose")

(gs:menu-popup 'EditMenuPopup "Edit")
(gs:menu-item 'EditCutP 'cutbutton-handler "Cut")
(gs:menu-item 'EditCopyP 'copybutton-handler "Copy")
(gs:menu-item 'EditPasteP 'pastebutton-handler "Paste")

(gs:menu 'ViewMenu "View")
(gs:menu-item 'ViewClearMonitor 'viewclearmonitor-handler "Clear monitor")
(gs:menu-item-check 'ViewToolbar 'viewtoolbar-handler "Toolbar" (= currentToolbarShow "yes"))
(gs:menu-item-check 'ViewSyntax 'viewsyntax-handler "Syntax coloring" true)
(dolist (T config:currentThemes)
	(gs:menu-item (string "ViewTheme" $idx) 'theme-handler (T 0)))
(gs:menu-item 'ViewFontBook 'fontbookbutton-handler "Font faces ...")
(gs:menu-item 'ViewFontSmaller 'viewfontsmaller-handler "Font smaller")
(gs:menu-item 'ViewFontBigger 'viewfontbigger-handler "Font bigger")

(gs:menu 'ToolMenu "Tools")
(gs:menu-item 'ToolEditSettings 'tooleditsettings-handler "Edit Settings")
(dolist (T config:currentScripts)
	(gs:menu-item (string "ToolScript" $idx) 'script-handler (T 0))
	(if (= 4 (length T)) 
		(gs:set-accelerator (string "ToolScript" $idx) (T 3)))
)

(gs:menu 'HelpMenu "Help")
(gs:menu-item 'HelpAbout 'helpabout-handler "About newLISP-GS")
(gs:menu-item 'HelpManual 'helpmanual-handler "newLISP Manual and Reference")
(gs:menu-item 'HelpDemos 'opendemos-handler "Open Demo Folder")
(gs:menu-item 'HelpGuiserver 'helpguiserver-handler "GS Manual")

(gs:menu 'RunMenu "Run")
(gs:menu-item 'RunRun 'process-or-execbutton-handler "Run")
(gs:set-icon 'RunRun "/local/run16.png")
(gs:menu-item 'RunRestart 'start-newlisp-shell "Restart")
(gs:menu-item 'RunShell 'startshell-handler "Alternate shell")

(gs:menu-popup 'SyntaxMenu "Syntax")
(gs:menu-item 'SyntaxNewlisp 'syntaxmenu-handler "newLISP syntax")
(gs:menu-item 'SyntaxC 'syntaxmenu-handler "C syntax")
(gs:menu-item 'SyntaxCPP 'syntaxmenu-handler "C++ syntax")
(gs:menu-item 'SyntaxJava 'syntaxmenu-handler "Java syntax")
(gs:menu-item 'SyntaxPHP 'syntaxmenu-handler "PHP syntax")
(gs:add-to 'SyntaxMenu 'SyntaxNewlisp 'SyntaxC 'SyntaxCPP 'SyntaxJava 'SyntaxPHP)

(if (= ostype "OSX")
	(begin ;; MacOS X keyboard
		(gs:set-accelerator 'FileClear "shift meta N")
		(gs:set-accelerator 'FileNew "meta N")
		(gs:set-accelerator 'FileOpen "meta O")
		(gs:set-accelerator 'FileClose "meta W")
		(gs:set-accelerator 'FileSave "meta S")
		(gs:set-accelerator 'FileSaveAs "shift meta S")
		(gs:set-accelerator 'EditUndo "meta Z")
		(gs:set-accelerator 'EditRedo "shift meta Z")
		(gs:set-accelerator 'EditCut "meta X")
		(gs:set-accelerator 'EditCopy "meta C")
		(gs:set-accelerator 'EditPaste "meta V")
		(gs:set-accelerator 'EditGoto "meta L")
		(gs:set-accelerator 'EditPosition "shift meta L")
		(gs:set-accelerator 'EditGotoEditor "meta 1")
		(gs:set-accelerator 'EditGotoShell "meta 2")
		(gs:set-accelerator 'EditFind "meta F")
		(gs:set-accelerator 'EditFindDispose "meta D")
		(gs:set-accelerator 'EditFindPrevious "shift meta G")
		(gs:set-accelerator 'EditFindNext "meta G")
		(gs:set-accelerator 'EditReplace "meta J")
;		(gs:set-accelerator 'EditReplaceNext "shift meta J")
		(gs:set-accelerator 'RunRun "meta R")
		(gs:set-accelerator 'RunRestart "shift meta R")
		(gs:set-accelerator 'ViewClearMonitor "meta M")
		(gs:set-accelerator 'ViewFontBook "meta T")
		(gs:set-accelerator 'ViewFontSmaller "meta MINUS")
		(gs:set-accelerator 'ViewFontBigger "shift meta EQUALS")
		(gs:set-accelerator 'ViewSyntax "meta Y")
	)
	(begin ;; PC keyboard 
		(gs:set-accelerator 'FileClear "ctrl N")
		(gs:set-accelerator 'FileNew "shift ctrl N")
		(gs:set-accelerator 'FileOpen "ctrl O")
		(gs:set-accelerator 'FileClose "ctrl W")
		(gs:set-accelerator 'FileSave "ctrl S")
		(gs:set-accelerator 'FileSaveAs "shift ctrl S")
		(gs:set-accelerator 'EditUndo "ctrl Z")
		(gs:set-accelerator 'EditRedo "shift ctrl Z")
		(gs:set-accelerator 'EditCopy "ctrl C")
		(gs:set-accelerator 'EditCut "ctrl X")
		(gs:set-accelerator 'EditPaste "ctrl V")
		(gs:set-accelerator 'EditGoto "alt L")
		(gs:set-accelerator 'EditPosition "shift alt L")
		(gs:set-accelerator 'EditGotoEditor "alt 1")
		(gs:set-accelerator 'EditGotoShell "alt 2")
		(gs:set-accelerator 'EditFind "ctrl F")
		(gs:set-accelerator 'EditFindPrevious "shift ctrl G")
		(gs:set-accelerator 'EditFindNext "ctrl G")
		(gs:set-accelerator 'EditFindDispose "ctrl D")
		(gs:set-accelerator 'EditReplace "ctrl J")
;		(gs:set-accelerator 'EditReplaceNext "shift ctrl J")
		(gs:set-accelerator 'RunRun "alt R")
		(gs:set-accelerator 'RunRestart "shift alt R")
		(gs:set-accelerator 'ViewClearMonitor "ctrl M")
		(gs:set-accelerator 'ViewFontBook "ctrl T")
		(gs:set-accelerator 'ViewFontSmaller "ctrl MINUS")
		(gs:set-accelerator 'ViewFontBigger "ctrl EQUALS")
		(gs:set-accelerator 'ViewSyntax "alt Y")
	)
)

;; disable Save and SaveAs until content in EditArea
(gs:disable 'FileSave 'FileSaveAs)
;; disable Cut and Copy menu items until selection is made
(gs:disable 'EditUndo 'EditRedo 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
;; disable various find dialog options until dialog is up first
(gs:disable 'EditFindPrevious 'EditFindNext 'EditReplace 'EditFindDispose)
;; disable monitor clear until something is in it
;(gs:disable 'ViewClearMonitor)

; File menu
(gs:add-to 'FileMenu 'FileClear 'FileNew 'FileClose)
(gs:add-separator 'FileMenu)
(gs:add-to 'FileMenu 'FileRecent)
(gs:add-separator 'FileMenu)
(gs:add-to 'FileMenu 'FileOpen 'FileSave 'FileSaveAs)
(gs:add-separator 'FileMenu)
(gs:add-to 'FileMenu 'FileSettings)
(gs:add-separator 'FileMenu)
(gs:add-to 'FileMenu 'FileQuit)

; Edit menun
(gs:add-to 'EditMenu 'EditUndo 'EditRedo)
(gs:add-separator 'EditMenu)
(gs:add-to 'EditMenu 'EditCut 'EditCopy 'EditPaste)
(gs:add-separator 'EditMenu)
(gs:add-to 'EditMenu 'EditGoto 'EditPosition 'EditGotoEditor 'EditGotoShell)
(gs:add-separator 'EditMenu)
(gs:add-to 'EditMenu 'EditFind 'EditFindNext 'EditFindPrevious 'EditReplace)
(gs:add-separator 'EditMenu)
(gs:add-to 'EditMenu 'EditFindDispose)
(gs:disable 'EditFindDispose)
; edit area popup
(gs:add-to 'EditMenuPopup 'EditCutP 'EditCopyP 'EditPasteP)

; View menu
(gs:add-to 'ViewMenu 'ViewClearMonitor)
(gs:add-separator 'ViewMenu)
(gs:add-to 'ViewMenu 'ViewToolbar 'ViewSyntax)
(gs:add-separator 'ViewMenu)
(dolist (T config:currentThemes)
	(gs:add-to 'ViewMenu (string "ViewTheme" $idx)))
(gs:add-separator 'ViewMenu)
(gs:add-to 'ViewMenu 'ViewFontBook 'ViewFontSmaller 'ViewFontBigger)

(if (empty? currentAltShell)
	(gs:add-to 'RunMenu 'RunRun 'RunRestart)
	(gs:add-to 'RunMenu 'RunRun 'RunRestart 'RunShell))

; Tool menu
(gs:add-to 'ToolMenu 'ToolEditSettings)
(gs:add-separator 'ToolMenu)
(dolist (T config:currentScripts)
	(gs:add-to 'ToolMenu (string "ToolScript" $idx)))

; Help menu
;; manuals are not added to Help on Win32 because open browser
;; prevents newlisp-edit/guiserever.jar from exiting
(if (= ostype "Win32")
	(begin
		(gs:add-to 'HelpMenu 'HelpDemos)
		(gs:add-separator 'HelpMenu)
		(gs:add-to 'HelpMenu 'HelpAbout))
	(begin
		(gs:add-to 'HelpMenu 'HelpManual 'HelpGuiserver)
		(gs:add-separator 'HelpMenu)
		(gs:add-to 'HelpMenu 'HelpDemos)
		(if (!= ostype "OSX")
			(begin
			(gs:add-separator 'HelpMenu)
			(gs:add-to 'HelpMenu 'HelpAbout)
))))

(gs:menu-bar 'TheEditor 'FileMenu 'EditMenu 'RunMenu 'ViewMenu 'ToolMenu 'HelpMenu)

(gs:set-visible 'TheEditor true)
(gs:dispose-splash)

; start auxiliary shell newLISP process for evaluation of edit area in OutputArea
(start-newlisp-shell)

(gs:request-focus currentEdit) ; set focus on editarea

; check if user settings where loaded succesfully
(if loadUserSettingsError
	(gs:message-dialog 'TheEditor (string "Problem loading: " userSettingsPath ".")
		loadUserSettingsError "warning")
)

;;;; define actions

(define (clear-current-tab)
	(gs:clear-text currentEdit)
	(set 'currentDir $HOME)
	(set 'currentFile "Untitled.lsp")
	(set 'currentPath (string currentDir "/" currentFile))
	(set 'currentDot 0 'currentMark 0)
	(update-current-tab)
	(gs:disable 'SaveButton 'CutButton 'CopyButton 'FileSave 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
	(gs:set-icon 'EditorTabs "/local/green10.png" currentTabIndex)
	(gs:set-text 'EditorTabs currentFile currentTabIndex)
	(gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
)
		
(define (fileclose-handler)
	(if (not edit-buffer-clean)
		(gs:confirm-dialog 'TheEditor 'fileclose-action "Close file tab" 
			(string "Abandon unsaved " currentFile "?") "yes-no")
		(fileclose-action 'TheEditor 0)
	)	
)

(define (fileclose-action id result)
	(if (= result 0)
		(if (> (length tabs-stack) 1)
			(begin
				(gs:remove-tab 'EditorTabs currentTabIndex)
				(replace-assoc currentEdit tabs-stack)
				(if (= currentTabIndex (length tabs-stack)) ; it was the right most tab
					(dec 'currentTabIndex)
					(begin ; its was not the most roght which was removed
						(set 'currentEdit (first (tabs-stack currentTabIndex)))
						(switch-to-tab currentEdit)
					)
				)
			)
			(clear-current-tab)
		)
	)
)

(define (newbutton-handler)
	(update-current-tab)
	(set 'currentDir $HOME)
	(set 'currentFile "Untitled.lsp")
	(set 'currentPath (string currentDir "/" currentFile))
	(set 'currentDot 0 'currentMark 0)
	(set 'edit-buffer-clean true)
	(set 'currentEdit (make-editor-tab currentDir currentFile))
	(gs:insert-tab 'EditorTabs currentEdit currentFile (length tabs-stack))
	(gs:request-focus 'EditorTabs (length tabs-stack))
	(gs:request-focus currentEdit) ; set focus in edit area
	(theme-handler (string "ViewTheme" currentThemeIdx))
)

(define (recentfiles-handler id)
	(update-current-tab)
	(let (file (lookup id recentFiles))
		(if (not (file? file))
			(gs:message-dialog 'TheEditor "Loading file" (append "Cannot find: " file))
			(begin
				(set 'currentPath (lookup id recentFiles))
				(open-currentpath-in-tab)
			)
		)
	)
)

(define (loadbutton-handler id)
	(gs:open-file-dialog 'TheEditor 'openfile-action  currentDir 
		".lsp .c .h .txt .java .htm .html .css .php .pl .py .rb .lisp .el .cl .cpp .tcl .config" 
		"Various text formats")
)

(define (openfile-action id  op file)
	(if file
		(begin
			(update-current-tab)
			(set 'currentPath (base64-dec file))
			(open-currentpath-in-tab)
		)
	)
)

(define (open-currentpath-in-tab)
	(set 'currentDir (join (chop (parse currentPath {\\|/} 0)) "/" ))
	(set 'currentFile (last (parse currentPath {\\|/} 0)))
	(set 'currentEdit (make-editor-tab currentDir currentFile))
	(set 'edit-buffer-clean true)
	(set 'currentDot 0 'currentMark 0)
	(gs:insert-tab 'EditorTabs currentEdit currentFile (length tabs-stack))
	(gs:request-focus 'EditorTabs (length tabs-stack))
	(gs:request-focus currentEdit) ; set focus in edit area
	(gs:set-cursor currentEdit "wait")

	(gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
	(gs:enable 'FileSaveAs)

	(gs:load-text currentEdit currentPath)
	(set 'currentSyntaxStatus (current-file-syntax))
	(theme-handler (string "ViewTheme" currentThemeIdx))
	(gs:set-cursor currentEdit "default")
)

(define (savebutton-handler id)
	(if (= currentFile "Untitled.lsp")
		(saveasbutton-handler id)
		(savefile-action id op (base64-enc currentPath) true)
	)
)

(define (saveasbutton-handler id) 
	(gs:save-file-dialog 'TheEditor 'savefile-action currentDir currentFile)
)

(define (savefile-action id op file no-check)
	(set 'save-file-candidate file)
	(if file (if no-check 
		(writefile-prepare file)
		(begin
			(if (file? (base64-dec file))
				(gs:confirm-dialog 'TheEditor 'confirmsave-action "Save As ..." 
					(append "Overwrite " (base64-dec file) "?") "yes-no-cancel")
				(writefile-prepare file)
			)
		))
	)
)

(define (confirmsave-action id result)
	(if (= result 0) 
		(writefile-prepare save-file-candidate))
	(if (= result 1)
		(saveasbutton-handler 'FileSaveAs))
)	

(define (writefile-prepare file)
	(set 'currentPath (base64-dec file))
	(set 'currentDir (join (chop (parse currentPath {\\|/} 0)) "/" ))
	(set 'currentFile (last (parse currentPath {\\|/} 0)))

	(gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
	(gs:set-text 'EditorTabs currentFile currentTabIndex)
	(gs:disable 'FileSave 'SaveButton)
	(gs:set-icon 'EditorTabs "/local/green10.png" currentTabIndex)
	(set 'edit-buffer-clean true)

	(gs:get-text currentEdit 'writefile-action)
)

(define (writefile-action id text)
	(local (bytes)
		(if text
			(if (= ostype "Win32")
				(set 'bytes (write-file currentPath (replace "\n" (base64-dec text) "\r\n")))
				(set 'bytes (write-file currentPath (base64-dec text)) ) ))
		(save-recent-list)
		(if (not bytes)
			(gs:message-dialog 'TheEditor "Saving file" (append "Could not save " currentPath))
			(output-monitor (string "--- " bytes " bytes saved to " currentPath " ---\n"))
		)
	)
)

(define (save-recent-list)
	(if (ref currentPath recentFiles)
		(push (pop recentFiles (first (ref currentPath recentFiles))) recentFiles)
		(push (list (uuid) currentPath) recentFiles))
	(set 'recentFiles (0 12 recentFiles))
	(save recentFilesPath 'recentFiles)
)

(define (savesettings-handler)
	(pretty-print 256) ; force one lone line for themes
	(gs:get-bounds 'TheEditor)
	(set 'currentAppX (gs:bounds 0))
	(set 'currentAppY (gs:bounds 1))
	(set 'currentAppWidth (gs:bounds 2))
	(set 'currentAppHeight (gs:bounds 3))
	(set 'config:currentAppX currentAppX)
	(set 'config:currentAppY currentAppY)
	(set 'config:currentAppWidth currentAppWidth)
	(set 'config:currentAppHeight currentAppHeight)
	(set 'config:currentForeground currentForeground)
	(set 'config:currentBackground currentBackground)	
	(set 'config:currentDir currentDir)
	(set 'config:currentFontName currentFontName)
	(set 'config:currentFontSize currentFontSize)
	(set 'config:currentMonitorFontSize currentMonitorFontSize)
	(set 'config:currentToolbarFloatable currentToolbarFloatable)
	(set 'config:currentTabsPosition currentTabsPosition)
	(set 'config:currentToolbarShow currentToolbarShow)
	(set 'config:currentThemeIdx currentThemeIdx)
	(set 'config:currentThemeHelp
			{background foreground caret selection comments keywords strings numbers quoted parentheses})
	(set 'config:currentAltShell currentAltShell)
	(set 'config:currentMonitorForeground currentMonitorForeground)
	(set 'config:currentMonitorBackground currentMonitorBackground)
	(save userSettingsPath 'config)
	(output-monitor 
		(string "--- saved settings in: " userSettingsPath " ---\n"))
)

(define (tooleditsettings-handler)
	(set 'currentPath userSettingsPath)
	(open-currentpath-in-tab)
)

(define (opendemos-handler)
	(gs:open-file-dialog 'TheEditor 'openfile-action  (string newlispDir "/guiserver")
		".lsp" "newLISP files")
)

(define (quitbutton-handler)
	(let (is-clean-tabs true)
		(dolist (tab tabs-stack)
			(if (not (tab 3 0)) (set 'is-clean-tabs nil)))
		(if (and is-clean-tabs edit-buffer-clean)
			(gs:confirm-dialog 'TheEditor 'quitconfirm-action
				"Quit newLISP edit" "You really want to quit?" "yes-no")
			(gs:confirm-dialog 'TheEditor 'quitconfirm-action
				"Quit newLISP edit" "Quit and lose unsaved content?" "yes-no")
		)
	)
)

(define (quitconfirm-action id result)
	(if (= result 0) 
		(begin
			;(println "destroying shell")
			(gs:destroy-shell 'OutputArea)
			(exit))
	)
)

(define (clearbutton-handler)
	(if (not edit-buffer-clean)
		(gs:confirm-dialog 'TheEditor 'clearconfirm-action 
			"New edit" (string "Abandon unsaved content in " currentFile) "yes-no")
		(clearbutton-action)
	)
)

(define (clearconfirm-action id result)
	(if (= result 0)
		(clearbutton-action))
)

(define (clearbutton-action)
	(set 'currentPath (string currentDir "/" currentFile))
	(gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
	(gs:clear-text currentEdit)
	(gs:set-icon 'EditorTabs "/local/green10.png" currentTabIndex)
	(set 'edit-buffer-clean true)
	(gs:disable 'SaveButton 'FileSave))

(define (undo-handler)
	(gs:undo-text currentEdit ))

(define (redo-handler)
	(gs:redo-text currentEdit))

(define (copybutton-handler)
	(gs:copy-text currentEdit))

(define (cutbutton-handler)
	(gs:enable 'FileSave 'FileSaveAs 'SaveButton)
	(gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
	(set 'edit-buffer-clean nil)
	(gs:cut-text currentEdit)
	(gs:request-focus 'CutButton))

(define (pastebutton-handler)
	(paste-action))

(define (paste-action text)
	(gs:enable 'FileSave 'FileSaveAs 'SaveButton)
	(gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
	(set 'edit-buffer-clean nil)
	(gs:paste-text currentEdit text))

;; goto line

(define (goto-handler)
	(gs:dialog 'GotoDialog 'TheEditor "Goto Line" 200 60 nil nil)
	(gs:set-resizable 'GotoDialog nil)
	(gs:set-flow-layout 'GotoDialog "center")
	(gs:label 'GotoTextLabel "Line:")
	(gs:text-field 'GotoTextField 'gotoline-action 4)
	(gs:button 'GotoButton 'gotogettext-action "Goto")
	(gs:add-to 'GotoDialog 'GotoTextLabel 'GotoTextField 'GotoButton)
	(gs:set-visible 'GotoDialog true)
)

(define (gotoline-action id text)
	(if text
		(let (line (int (base64-dec text) 0))
			(gs:goto-text currentEdit line 0))	)
	(gs:dispose 'GotoDialog)
	(gs:request-focus currentEdit)
)

(define (gotogettext-action)
	(gs:get-text 'GotoTextField 'gotoline-action)
)

(define (position-handler)
	(gs:get-text-position currentEdit)
	(output-monitor (string "--- line: " (gs:text-position 0) " column: " (gs:text-position 1) " ---\n"))
)

(define (switchwindow-handler id)
	(if (= id "MAIN:EditGotoEditor")
		(gs:request-focus currentEdit)
		(gs:request-focus 'OutputArea))
)

;;;;;;;;;;;;; find text ;;;;;;;;;;;;;;;

(define (findbutton-handler)
	(if findDialogOpen 
		(begin
			(gs:request-focus 'FindTextField)
			(gs:select-text 'FindTextField 0))
		(openFindDialog)
	)
)

(define (openFindDialog)
	(gs:dialog 'FindDialog 'TheEditor "Find text" 420 200 nil nil)
	(gs:set-resizable 'FindDialog nil)
	(gs:frame-closed 'FindDialog 'finddialogclose-handler)
	(gs:set-grid-layout 'FindDialog 4 1)
	
	(gs:panel 'FindPanel)
	(gs:label 'FindTextLabel "Find:")
	(gs:text-field 'FindTextField 'findtextnext-action 24)
	(gs:add-to 'FindPanel 'FindTextLabel 'FindTextField)
	
	(gs:panel 'ReplacePanel)
	(gs:label 'FindReplaceLabel "Replace:")
	(gs:text-field 'FindReplaceField 'findtextnext-action 24)
	(gs:add-to 'ReplacePanel 'FindReplaceLabel 'FindReplaceField)
	(if (not (null? currentSearchText)) (gs:set-text 'FindTextField currentSearchText))
	(if (not (null? currentReplaceText)) (gs:set-text 'FindReplaceField currentReplaceText))

	(gs:panel 'ButtonPanel-1)
	(gs:button 'FindTextPreviousButton 'findtextprevious-action "Previous")
	(gs:button 'FindTextNextButton 'findtextnext-action "Next")
	(gs:button 'FindTextReplaceButton 'findtextreplace-action "Replace")
	(gs:add-to 'ButtonPanel-1 'FindTextPreviousButton 'FindTextNextButton 'FindTextReplaceButton)
	(gs:panel 'ButtonPanel-2)
	(gs:button 'FindTextReplaceNextButton 'findtextreplacenext-action "Replace and Next")
	(gs:button 'FindTextUndoPrevButton 'findtextundoprev-action "Undo Previous")
	(gs:add-to 'ButtonPanel-2 'FindTextReplaceNextButton 'FindTextUndoPrevButton)

	(gs:set-tool-tip 'FindTextPreviousButton "Find previous occurrence of the find text")
	(gs:set-tool-tip 'FindTextNextButton "Find next occurrence of the find text")
	(gs:set-tool-tip 'FindTextReplaceButton "Replace selected text with replacement text")
	(gs:set-tool-tip 'FindTextReplaceNextButton "Replace next occurence")
	(gs:set-tool-tip 'FindTextUndoPrevButton "Undo previous replacement")

	(gs:add-to 'FindDialog 'FindPanel 'ReplacePanel 'ButtonPanel-1 'ButtonPanel-2)
	(gs:set-visible 'FindDialog true)
	(gs:disable 'FindTextReplaceButton 'FindTextReplaceNextButton 'FindTextUndoPrevButton)
	(gs:enable 'EditFindPrevious 'EditFindNext 'EditReplace 'EditFindDispose)
	(gs:select-text 'FindTextField 0)
	(set 'findDialogOpen true)
)

(define (finddispose-handler)
	(gs:dispose 'FindDialog)
	(gs:disable 'EditFindDispose)
	(set 'findDialogOpen nil)
)

(define (finddialogclose-handler id)
	(gs:enable 'FindButton 'EditFind)
	(gs:disable 'EditFindDispose)
	(set 'findDialogOpen nil)
)

(define (findtextcheckbox-action id flag)
	(println id " " flag)
)

;; find next, this handler is enterd first by all
;; FindDialog events, text-field(s) and button(s)

(define (findtextnext-action id text)
	(if (and (or (= id "MAIN:FindTextField") (= id "MAIN:FindReplaceField")) (not text)) 
		(finddispose-handler) ; ESC key was pressed
		(begin
			(set 'currentSearchDirection "next")
			(gs:get-text 'FindTextField 'getfindtext-action)
		)
	)
)

;; find previous

(define (findtextprevious-action)
	(set 'currentSearchDirection "previous")
	(gs:get-text 'FindTextField 'getfindtext-action)
)


;; retrieve search field text

(define (getfindtext-action id text)
	(if text
		(begin
			(set 'currentSearchText (base64-dec text))
			(gs:get-text 'FindReplaceField 'getreplacetext-action)
		)
		(gs:request-focus currentEdit)
	)
)

;; rertrieve replace field text

(define (getreplacetext-action id text)
	(set 'currentReplaceText (if text (base64-dec text) ""))
	(if (not (null? currentSearchText))
		(gs:find-text currentEdit currentSearchText 'findtextresult-action currentSearchDirection))
)

(define (findtextresult-action id result)
	(if (= result -1)
		(begin
			(gs:set-text 'FindDialog "Not found")
			(gs:disable 'FindTextReplaceNextButton)
			(when (and (= currentDot currentMark) (= currentSearchDirection "next"))
				(set 'currentMark (inc 'currentDot))
				(gs:set-caret currentEdit currentMark)
			)
		)
		(begin
			(gs:set-text 'FindDialog "Find text")
			(gs:enable 'FindTextReplaceButton 'FindTextReplaceNextButton)
			(gs:request-focus currentEdit)
		)
	)
)

;; replace

(define (findtextreplace-action)
	(gs:undo-enable currentEdit nil)
	(if (!= currentMark currentDot)
		(gs:paste-text currentEdit currentReplaceText))
	;(gs:request-focus currentEdit)
	(gs:disable 'FindTextReplaceButton 'FindTextReplaceNextButton)
	(gs:enable 'FindTextUndoPrevButton)
	(gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
	(set 'edit-buffer-clean nil)
	(gs:enable 'FileSave 'FileSaveAs 'SaveButton 'EditUndo)
	(gs:undo-enable currentEdit true)
)
	
;; replace and next

(define (findtextreplacenext-action)
	(gs:undo-enable currentEdit nil)
	(gs:paste-text currentEdit currentReplaceText)
	(gs:disable 'FindTextReplaceButton)
	(gs:enable 'FindTextReplaceNextButton 'FindTextUndoPrevButton)
	(gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
	(set 'edit-buffer-clean nil)
	(gs:enable 'FileSave 'FileSaveAs 'SaveButton 'EditUndo)
	(set 'currentSearchDirection "next")
	(gs:get-text 'FindTextField 'getfindtext-action)
	(gs:undo-enable currentEdit true)
)

; previous and undo
(define (findtextundoprev-action)
	(gs:undo-enable currentEdit nil)
	(gs:find-text currentEdit currentReplaceText 'findpreviousresult-action "previous")
	(gs:undo-enable currentEdit true)
)

(define (findpreviousresult-action id result)
	(if (= result -1)
		(begin
			(gs:set-text 'FindDialog "Not found for undo")
			(gs:disable 'FindTextUndoPrevButton 'FindTextReplaceButton 'FindTextReplaceNextButton)
		)
		(begin
			(gs:paste-text currentEdit currentSearchText)
			(gs:request-focus currentEdit)
		)
	)
)

;; view menu fonts bigger/smaller handlers

(define (viewfontsmaller-handler)
	(dec 'currentFontSize)
	(gs:set-text 'FontSizeLabel (string currentFontSize))
	(gs:set-font currentEdit currentFontName currentFontSize "plain"))

(define (viewfontbigger-handler)
	(inc 'currentFontSize)
	(gs:set-text 'FontSizeLabel (string currentFontSize))
	(gs:set-font currentEdit currentFontName currentFontSize "plain"))

;; 

(define (fontbookbutton-handler)
	(gs:dialog 'FontBookSelection 'TheEditor "Click on a font name to select it" 300 200 nil nil)
	(gs:set-background 'FontBookSelection 1 1 1)
	(gs:get-fonts)
	(gs:panel 'FontPanel)
	(gs:set-grid-layout 'FontPanel (length gs:fonts) 1 0 0)
	(dolist (font gs:fonts)
		(set 'font-label (string "label-" $idx))
		(gs:label font-label font)
		(if (= font currentFontName)
			(gs:set-foreground font-label 0.8 0.5 0.0))
		(gs:set-size font-label 100 30)
		(gs:set-font font-label font 24 "plain")
		(gs:mouse-event font-label 'mouse-action)
		(gs:add-to 'FontPanel font-label))

	(gs:scroll-pane 'Scroll 'FontPanel)
	(gs:add-to 'FontBookSelection 'Scroll)
	(gs:set-visible 'FontBookSelection true)
)

;; handle mouse clicks in font book
(define (mouse-action id type x y button cnt mods)
	(if (= type "pressed")
		(gs:set-foreground id 0.8 0.5 0.0)
		(begin
			(set 'currentFontName (gs:fonts (int (last (parse id "-")) 0)))
			(gs:set-font currentEdit currentFontName currentFontSize "plain")
			(gs:set-foreground id 0 0 0))
	)
)

;; font panel mouse click handler

(define (fontpanel-event id  type x y button cnt modifiers)
	(if (= type "clicked") 
		(case id
			("MAIN:FontBiggerLabel" (viewfontbigger-handler))
			("MAIN:FontSmallerLabel" (viewfontsmaller-handler))
		)
	)
)

;; initialize syntax for first tab
(theme-handler (string "ViewTheme" currentThemeIdx))
;;;;;;;;;;;; exec  newlisp over editor contents ;;;;;;;;;;

(define (process-or-execbutton-handler)
	(if (not (directory? $TEMP))
		(gs:message-dialog 'TheEditor "Cannot find temporal directory" 
				(append "Need to create a directory " $TEMP) "information")
		(begin
			(disable-main-tools)
;			(gs:get-text currentEdit 'exec-handler)
			(gs:get-text currentEdit 'auxiliary-process-handler)
			(gs:enable 'ViewClearMonitor)
		)
	)
)

; evaluates content of editor area in the auxiliary newLISP
; process, as output is generated it is displayed in the
; monitor area
(define (auxiliary-process-handler id text)
	(if text
		(begin
			(set 'text (base64-dec text))
			(write-file "editor.txt" text)
			(gs:eval-shell 'OutputArea (string "[cmd]\n" text "\n[/cmd]\n"))))
	(after-exec-or-process)
)

; after the exec or auxiliary process execution
; enable buttons, menus and edit area
(define (after-exec-or-process)
	(gs:enable 'FileMenu 'EditMenu 'ViewMenu 'RunMenu)
	(gs:enable 'NewButton 'ClearButton 'PasteButton 
				'LoadButton 'ExecButton 'RestartButton 'FindButton 'FontBookButton)
	(gs:set-editable  currentEdit true)
	(if (not edit-buffer-clean) (gs:enable 'SaveButton))
	(gs:request-focus currentEdit)
	(gs:select-text currentEdit currentDot currentMark)
	(if is-selection 
		(gs:enable 'CutButton 'CopyButton))
)

; disable main menus and toolbar
(define (disable-main-tools)
		(gs:disable 'FileMenu 'EditMenu 'ViewMenu 'RunMenu)
		(gs:disable 'NewButton 'ClearButton 'LoadButton 'SaveButton 
				'CutButton 'CopyButton 'PasteButton 
				'ExecButton 'RestartButton 'FindButton 'FontBookButton)
		(gs:set-editable  currentEdit nil)
)

;;;;;;;;;;;;;;;;;;;;;;;; end auxiliary process handling ;;;;;;;;;;;;;;;;;;;;;;;

;; clear bottom monitor area
(define (viewclearmonitor-handler)
	(gs:clear-text 'OutputArea)
	;(gs:disable 'ViewClearMonitor)
)

;; output to monitor area
(define (output-monitor str)
	(gs:append-text 'OutputArea str)
	(gs:enable 'ViewClearMonitor)
)

;; dtach/attach toolbar
(define (viewtoolbar-handler id flag)
	(if flag
		(begin
			(set 'currentToolbarShow "yes")
			(gs:add-to 'TheEditor 'ToolBar "north")
			; if the toolbar was not visible on startup
			; it will not be visible now, inspite of layout
			; this forces components of the container to be redrawn
			(gs:set-visible 'TheEditor true)
			(gs:layout 'TheEditor)
		)
		(begin
			(set 'currentToolbarShow "no")
			(gs:remove-from 'TheEditor 'ToolBar)	
			(gs:layout 'TheEditor)
		)
	)
)

;; syntax highlighting and themes 1,2,3
;; for menu-item theme-handler function
;; see beginning of file

(define (viewsyntax-handler id flag)
	(if flag
		(begin
			(set 'currentSyntaxStatus (current-file-syntax))
			(if (not currentSyntaxStatus)
					(begin
						(gs:set-selected 'ViewSyntax nil)
						(gs:show-popup 'SyntaxMenu 'TheEditor 100 100))
					(gs:set-syntax currentEdit currentSyntaxStatus)))
		(begin
			(set 'currentSyntaxStatus nil)
			(gs:set-syntax currentEdit nil))
	)
)

(define (syntaxmenu-handler id idx)
	(gs:set-syntax currentEdit (set 'currentSyntaxStatus 
		(case id
			("MAIN:SyntaxNewlisp" "lsp")
			("MAIN:SyntaxC" "c")
			("MAIN:SyntaxCPP" "cpp")
			("MAIN:SyntaxJava" "java")
			("MAIN:SyntaxPHP" "php")
		))
	)
	(gs:set-selected 'ViewSyntax (true? currentSyntaxStatus))
)

;; handle character and caret events from edit area
(define (editarea-handler id code mods dot mark len undo redo)
	(if undo (gs:enable 'EditUndo) (gs:disable 'EditUndo))
	(if redo (gs:enable 'EditRedo) (gs:disable 'EditRedo))
	(set 'currentDot dot 'currentMark mark)
;	(println code ":" mods)
	(if (= code 65535) ; crtl or meta keys wit or w/o shift
		; caret movement only
		(if (not is-selection)
			(if (!= dot mark) ; selection started
				(begin
					(gs:enable 'CutButton 'CopyButton 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
					(set 'is-selection true)))
			(if (= dot mark)  ; de-selected
				(begin
					(gs:disable 'CutButton 'CopyButton 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
					(set 'is-selection nil)))
		)
		; character typed
		(if edit-buffer-clean
			(begin
				(set 'edit-buffer-clean nil)
				(gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
				(gs:enable 'FileSave 'FileSaveAs 'SaveButton)
			)
		)
	)			
)

;; handle mouse clicks from editeara for popup menu
(define (editarea-mouse-handler id type x y button cnt modifiers)
	(if (or (= button 3) (= modifiers 18)); right button or ctrl click
		(gs:show-popup 'EditMenuPopup currentEdit x y)
	)
)

;; tabs have switched or a new tab has been inserted
(define (editortabs-handler id tab title idx)
	(update-current-tab)
	(set 'currentTabIndex idx)
	; get new tab edit area settings
	(set 'currentEdit tab)
	(switch-to-tab tab idx)
)

(define (switch-to-tab tab)
	(set 'currentDir (lookup currentEdit tabs-stack 1))
	(set 'currentFile (lookup currentEdit tabs-stack 2)) 
	(set 'currentPath (string currentDir "/" currentFile))
	(set 'currentStatus (lookup currentEdit tabs-stack 3))
	(set 'edit-buffer-clean (currentStatus 0))
	(if edit-buffer-clean
		(begin
			(gs:set-icon 'EditorTabs "/local/green10.png" currentTabIndex)
			(gs:disable 'FileSave 'SaveButton)
		)
		(begin
			(gs:set-icon 'EditorTabs "/local/red10.png" currentTabIndex)
			(gs:enable 'FileSave 'SaveButton)
		)
	)
	(set 'currentDot (currentStatus 1))
	(set 'currentMark (currentStatus 2))
	(set 'currentSyntaxStatus (currentStatus 3))
	(if (= currentDot currentMark) 
		(begin
			(set 'is-selection nil)
			(gs:disable 'CutButton 'CopyButton 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
			(gs:request-focus currentEdit) )
		(begin
			(set 'is-selection true)
			(gs:enable 'CutButton 'CopyButton 'EditCut 'EditCutP 'EditCopy 'EditCopyP)
			(gs:request-focus currentEdit)
			(gs:select-text currentEdit currentDot currentMark) )
	)
	(gs:set-text 'TheEditor (string "newLISP edit - " currentPath))
	(theme-handler (string "ViewTheme" currentThemeIdx))
)

(define (update-current-tab)
	(set 'currentStatus (list edit-buffer-clean currentDot currentMark currentSyntaxStatus))
	; save previous tab edit area settings
	(replace-assoc currentEdit tabs-stack (list currentEdit currentDir currentFile currentStatus))
)

;; help about box
;; on Mac OS X the built-in about box is shown (contained in guiserver.jar)
;; selectable from the Apple system menu
;; On other OSs the Help menu contains the following (identical loooking)
;; about box

(define (helpabout-handler)
	(if (!= ostype "OSX")
		(begin
			(gs:get-version)
			(gs:message-dialog 'TheEditor (string "newLISP-GS v." gs:version)
				(string "Software: copyright (c) 2007 Lutz Mueller http://newlisp.org\n" 
						"Icons: copyright (c) 2007 Michael Michaels http://neglook.com\n"
						"All rights reserved.")
				"information" "/local/newLISP64.png" )
		)
	)
)

;; show newLISP Users Manual and Reference

(define (helpmanual-handler)
	(load-platform-help "/manual_frame.html")
)

;; show GS Manual

(define (helpguiserver-handler)
	(load-platform-help "/guiserver/index.html")
)

(define (load-platform-help file-name , prog files)
	(if (not (file? (string newlispDoc file-name)))
		(gs:message-dialog 'TheEditor "Display documentation"
				(string "Cannot find file: " newlispDoc file-name)
                "warning"))
	(cond
		; Mac OS X
		((= ostype "OSX")
			(exec (string "open file://" newlispDoc file-name))
		)
		; Windows, loading docs from the menu has been disabled because open explorer blocks the Java part
		; of newlisp-edit.lsp from exiting
		((= ostype "Win32")
			(begin
				(set 'prog (string "cmd /c \"" (env "PROGRAMFILES") "/Internet Explorer/IEXPLORE.EXE\""))
				;(println "->" prog "<-")
				(exec (string prog " file://" newlispDoc file-name)))
		)
		; all other UNIX
		(true 
			(set 'files '(
					"/usr/bin/sensible-browser"
					"/usr/bin/x-www-browser"
					"/usr/bin/mozilla"
					"/usr/bin/konqueror"))
			(set 'prog (find true (map file? files)))
			(if prog
				(exec (string (files prog) " file://" newlispDoc file-name))
				(gs:message-dialog 'TheEditor "Display documentation"
						"Cannot find browser to display documentation" "warning")
			)
		)
	)
)


;; start listening for GUI events and output from auxiliary newLISP process
;; append out put from newLISP process to monitor area

(while (gs:check-event 10000)
	(if (and console (net-select console "read" 10000))
		(begin
			(if (> (net-peek console) 0) (begin
				(net-receive console 'response 10024)
				(output-monitor (or response ""))
				(sleep 100)
				))
			(check-status)
		)
	)
)

;; eof
