package provide pd_menucommands 0.1

namespace eval ::pd_menucommands:: {
    variable untitled_number "1"

    namespace export menu_*
}

# ------------------------------------------------------------------------------
# functions called from File menu

proc ::pd_menucommands::menu_new {} {
    variable untitled_number
    set untitled_name $::pdtk_canvas::untitled_name
    if { ! [file isdirectory $::filenewdir]} {set ::filenewdir $::env(HOME)}
    pdsend "pd menunew $untitled_name-$untitled_number [enquote_path $::filenewdir]"
    incr untitled_number
}

proc ::pd_menucommands::menu_open {} {
    if { ! [file isdirectory $::fileopendir]} {set ::fileopendir $::env(HOME)}
    set files [tk_getOpenFile -defaultextension .pd \
                       -multiple true \
                       -filetypes $::filetypes \
                       -initialdir $::fileopendir]
    if {$files ne ""} {
        foreach filename $files {
            open_file $filename
        }
        set ::fileopendir [file dirname $filename]
    }
}

# TODO set the current font family & size via the -fontmap option:
# http://wiki.tcl.tk/41871
proc ::pd_menucommands::menu_print {mytoplevel} {
    set initialfile "[file rootname [lookup_windowname $mytoplevel]].ps"
    set filename [tk_getSaveFile -initialfile $initialfile \
                      -title [_ "Print..." ] \
                      -defaultextension .ps \
                      -filetypes { {{Postscript} {.ps}} }]
    if {$filename ne ""} {
        set tkcanvas [tkcanvas_name $mytoplevel]
        # set $fontfind & $fontsub if font name needs to be fixed
        if {$::font_family eq "DejaVu Sans Mono"} {
            # capitalize V
            set fontfind "DejavuSansMono"
            set fontsub "DejaVuSansMono"
        } elseif {$::font_family eq "Menlo"} {
            # add -Regular suffix, -Bold is added automatically
            if {$::font_weight eq "normal"} {
                set fontfind "Menlo"
                set fontsub "Menlo-Regular"
            }
        }
        if {[info exists fontfind]} {
            # FIXME hack to fix incorrect PS font naming,
            # this could be removed in the future
            set ps [$tkcanvas postscript]
            regsub -all $fontfind $ps $fontsub ps
            set f [open $filename w]
            puts $f $ps
            close $f
        } else {
            $tkcanvas postscript -file $filename
        }
    }
}

# ------------------------------------------------------------------------------
# functions called from Edit menu

proc ::pd_menucommands::menu_undo {} {
    if { $::focused_window ne ".pdwindow" } {
        pdsend "$::focused_window undo"
    }
}

proc ::pd_menucommands::menu_redo {} {
    if { $::focused_window ne ".pdwindow" } {
        pdsend "$::focused_window redo"
    }
}

proc ::pd_menucommands::menu_editmode {state} {
    if {[winfo class $::focused_window] ne "PatchWindow"} {return}
    set ::editmode_button $state
# this shouldn't be necessary because 'pd' will reply with pdtk_canvas_editmode
#    set ::editmode($::focused_window) $state
    pdsend "$::focused_window editmode $state"
}

proc ::pd_menucommands::menu_toggle_editmode {} {
    menu_editmode [expr {! $::editmode_button}]
}

# ------------------------------------------------------------------------------
# generic procs for sending menu events

# send a message to a pd canvas receiver
proc ::pd_menucommands::menu_send {window message} {
    if { [catch {set mytoplevel [winfo toplevel $window]} ] } {
        ::pdwindow::logpost {} 4 "menu_send: skipping unknown window '$window'\n"
        return
    }
    if {[winfo class $mytoplevel] eq "PatchWindow"} {
        pdsend "$mytoplevel $message"
    } elseif {$mytoplevel eq ".pdwindow"} {
        if {$message eq "copy"} {
            tk_textCopy .pdwindow.text
        } elseif {$message eq "selectall"} {
            .pdwindow.text tag add sel 1.0 end
        } elseif {$message eq "menusaveas"} {
            ::pdwindow::save_logbuffer_to_file
        }
    }
}

# send a message to a pd canvas receiver with a float arg
proc ::pd_menucommands::menu_send_float {window message float} {
    set mytoplevel [winfo toplevel $window]
    if {[winfo class $mytoplevel] eq "PatchWindow"} {
        pdsend "$mytoplevel $message $float"
    }
}

# ------------------------------------------------------------------------------
# open the dialog panels

proc ::pd_menucommands::menu_message_dialog {} {
    ::dialog_message::open_message_dialog $::focused_window
}

proc ::pd_menucommands::menu_find_dialog {} {
    ::dialog_find::open_find_dialog $::focused_window
}

proc ::pd_menucommands::menu_font_dialog {} {
    if {[winfo exists .font]} {
        raise .font
        focus .font
    } elseif {$::focused_window eq ".pdwindow"} {
        pdtk_canvas_dofont .pdwindow [lindex [.pdwindow.text cget -font] 1]
    } else {
        pdsend "$::focused_window menufont"
    }
}

proc ::pd_menucommands::menu_path_dialog {} {
    if {[winfo exists .path]} {
        raise .path
        focus .path
    } else {
        pdsend "pd start-path-dialog"
    }
}

proc ::pd_menucommands::menu_startup_dialog {} {
    if {[winfo exists .startup]} {
        raise .startup
        focus .startup
    } else {
        pdsend "pd start-startup-dialog"
    }
}

proc ::pd_menucommands::menu_preference_dialog {} {
    pdsend "pd start-preference-dialog"
}

proc ::pd_menucommands::menu_manual {} {
    ::pd_menucommands::menu_doc_open doc/1.manual index.htm
}

proc ::pd_menucommands::menu_helpbrowser {} {
    ::helpbrowser::open_helpbrowser
}

# ------------------------------------------------------------------------------
# window management functions

proc ::pd_menucommands::menu_minimize {window} {
    wm iconify [winfo toplevel $window]
}

proc ::pd_menucommands::menu_maximize {window} {
    wm state [winfo toplevel $window] zoomed
}

proc ::pd_menucommands::menu_raise_pdwindow {} {
    # explicitly raise/lower & focus relative to the current window stack for Tk Cocoa
    if {$::focused_window eq ".pdwindow" && [winfo viewable .pdwindow]} {
        lower .pdwindow [lindex [wm stackorder .] 0]
        focus [lindex [wm stackorder .] end]
    } else {
        wm deiconify .pdwindow
        raise .pdwindow [lindex [wm stackorder .] end]
        focus .pdwindow
    }
}

# used for cycling thru windows of an app
proc ::pd_menucommands::menu_raisepreviouswindow {} {
    set mytoplevel [lindex [wm stackorder .] end]
    lower $mytoplevel [lindex [wm stackorder .] 0]
    focus $mytoplevel
}

# used for cycling thru windows of an app the other direction
proc ::pd_menucommands::menu_raisenextwindow {} {
    set mytoplevel [lindex [wm stackorder .] 0]
    raise $mytoplevel [lindex [wm stackorder .] end]
    focus $mytoplevel
}

# ------------------------------------------------------------------------------
# Pd window functions
proc menu_clear_console {} {
    ::pdwindow::clear_console
}

# ------------------------------------------------------------------------------
# manage the saving of the directories for the new commands

# this gets the dir from the path of a window's title
proc ::pd_menucommands::set_filenewdir {mytoplevel} {
    # TODO add Aqua specifics once g_canvas.c has [wm attributes -titlepath]
    if {$mytoplevel eq ".pdwindow"} {
        set ::filenewdir $::fileopendir
    } else {
        regexp -- ".+ - (.+)" [wm title $mytoplevel] ignored ::filenewdir
    }
}

# parse the textfile for the About Pd page
proc ::pd_menucommands::menu_aboutpd {} {
    set versionstring "Pd $::PD_MAJOR_VERSION.$::PD_MINOR_VERSION.$::PD_BUGFIX_VERSION$::PD_TEST_VERSION"
    set filename [file join $::sys_guidir about.txt]
    if {![file exists $filename]} {
        ::pdwindow::error [_ "ignoring '%s': doesn't exist" $filename]
        ::pdwindow::error "\n"
        #return
    }
    if {[winfo exists .aboutpd]} {
        wm deiconify .aboutpd
        raise .aboutpd
        focus .aboutpd
    } else {
        toplevel .aboutpd -class TextWindow
        wm title .aboutpd [_ "About Pd"]
        wm group .aboutpd .
        .aboutpd configure -menu $::dialog_menubar
        text .aboutpd.text -relief flat -borderwidth 0 -highlightthickness 0 \
            -yscrollcommand ".aboutpd.scroll set" -background white
        scrollbar .aboutpd.scroll -command ".aboutpd.text yview"
        pack .aboutpd.scroll -side right -fill y
        pack .aboutpd.text -side left -fill both -expand 1
        bind .aboutpd <$::modifier-Key-w> "destroy .aboutpd"

        if { [catch {
            set textfile [open $filename]
            while {![eof $textfile]} {
                set bigstring [read $textfile 1000]
                regsub -all PD_BASEDIR $bigstring $::sys_libdir bigstring2
                regsub -all PD_VERSION $bigstring2 $versionstring bigstring3
                .aboutpd.text insert end $bigstring3
            }
            close $textfile
        } stderr ] } {
            ::pdwindow::error [_ "couldn't read \"%s\" document" [_ "About Pd" ] ]
            ::pdwindow::error "\n\t$stderr\n"
            destroy .aboutpd
        }
    }
}

# ------------------------------------------------------------------------------
# opening docs as menu items (like the Test Audio and MIDI patch and the manual)
proc ::pd_menucommands::menu_doc_open {dir basename} {
    if {[file pathtype $dir] eq "relative"} {
        set dirname "$::sys_libdir/$dir"
    } else {
        set dirname $dir
    }
    set textextension "[string tolower [file extension $basename]]"
    if {[lsearch -exact [lindex $::filetypes 0 1]  $textextension] > -1} {
        set fullpath [file normalize [file join $dirname $basename]]
        set dirname [file dirname $fullpath]
        set basename [file tail $fullpath]
        pdsend "pd open [enquote_path $basename] [enquote_path $dirname] 1"
    } else {
        ::pd_menucommands::menu_openfile "$dirname/$basename"
    }
}

# open HTML docs from the menu using the OS-default HTML viewer
proc ::pd_menucommands::menu_openfile {filename} {
    if {$::tcl_platform(os) eq "Darwin"} {
        exec sh -c [format "open '%s'" $filename]
    } elseif {$::tcl_platform(platform) eq "windows"} {
        exec rundll32 url.dll,FileProtocolHandler [format "%s" $filename] &
    } else {
        foreach candidate { gnome-open xdg-open sensible-browser iceweasel firefox \
                                mozilla galeon konqueror netscape lynx } {
            set browser [lindex [auto_execok $candidate] 0]
            if {[string length $browser] != 0} {
                exec -- sh -c [format "%s '%s'" $browser $filename] &
                break
            }
        }
    }
}

# ------------------------------------------------------------------------------
# open the help-intro.pd patch which provides a list of core objects
proc ::pd_menucommands::menu_objectlist {} {
    pdsend "pd help-intro"
}

# ------------------------------------------------------------------------------
# Mac OS X specific functions

proc ::pd_menucommands::menu_bringalltofront {} {
    # use [winfo children .] here to include windows that are minimized
    foreach item [winfo children .] {
        # get all toplevel windows, exclude menubar windows
        if { [string equal [winfo toplevel $item] $item] && \
                 [catch {$item cget -tearoff}]} {
            wm deiconify $item
        }
    }
    wm deiconify .
}

# this is needed because on macOS the Menu-Accelerators are actually used
# (rather than just displayed)
# so this proc simply gobbles the commands to suppress duplicates:
# only the first $script until the next idle-period is run (the rest is discarded)
# see https://stackoverflow.com/a/69900053/1169096
proc ::pd_menucommands::scheduleAction {args} {
    if {$::pd_menucommands::currentAction eq ""} {
        # Prepend a command to clear the variable
        set act "set ::pd_menucommands::currentAction {};$args"
        set ::pd_menucommands::currentAction [after idle $act]
    }
}
set ::pd_menucommands::currentAction {}