#!/usrs/tm/src/moat -f

# An implementation of xmfm using tclMotif

set FILES_TOOLBAR_SIZE 6


#######################################################################
#
# This part creates the geometry of xtmfm, and sets up appropriate
# callbacks to handle behaviour
#
#######################################################################

#
# createApplication
#   - toplevel create function for the whole lot
#
proc createApplication {} {
  xmMainWindow .main

  xmForm .main.form

  xmLabel .main.form.dirLabel

  set filesToolbar [createFilesToolbar .main.form]

  set dirsToolbar [createDirsToolbar .main.form]

  set pane [createPane .main.form]

  set menu [createMenu .main]

  panelSetFiles $pane

  $menu manageChild
  $dirsToolbar manageChild
  $filesToolbar manageChild
  $pane manageChild
  .main.form.dirLabel manageChild
  .main.form manageChild
  .main manageChild

  setGeometry .main.form.dirLabel $filesToolbar $dirsToolbar $pane

  .main setValues -menuBar $menu -workWindow .main.form
}

#
# createFilesToolbar
# 
proc createFilesToolbar {parent} {
  global FILES_TOOLBAR_SIZE
  global fileToolbarButtons

  xmRowColumn $parent.filesToolbar managed \
    -numColumns		3 \
    -packing	 	pack_column \
    -orientation	horizontal \
    -adjustLast		false

  for {set n 0} {$n < $FILES_TOOLBAR_SIZE} {incr n} {
    set button [xmPushButton $parent.filesToolbar.filesToolbarButton$n managed \
				-labelString " "]
    $button activateCallback "fileToolButtonPressed $n"
    set fileToolbarButtons($n) $button
  }

  return $parent.filesToolbar
}

#
# createDirsToolbar
#
proc createDirsToolbar {parent} {
  global FILES_TOOLBAR_SIZE

  xmRowColumn $parent.dirsToolbar managed \
    -numColumns		3 \
    -packing	 	pack_column \
    -orientation	horizontal \
    -adjustLast		false

  for {set n 0} {$n < $FILES_TOOLBAR_SIZE} {incr n} {
    set button [xmPushButton $parent.dirsToolbar.dirsToolbarButton$n managed \
				-labelString " "]
    $button activateCallback "fileToolButtonPressed $n"
  }

  return $parent.dirsToolbar
}

#
# createMenu
#
proc createMenu {parent} {
  # top menu bar
  xmMenuBar $parent.menuBar managed
  xmCascadeButton $parent.menuBar.file managed \
        -labelString File \
        -mnemonic F
  xmCascadeButton $parent.menuBar.edit managed \
        -labelString Edit \
        -mnemonic E
  xmCascadeButton $parent.menuBar.help managed \
         -labelString Help \
        -mnemonic H

  # file pulldown
  xmPulldownMenu $parent.fileMenu
  xmPushButton $parent.fileMenu.new managed \
        -labelString "New..." \
        -mnemonic N
  xmPushButton $parent.fileMenu.quit managed \
         -labelString Quit \
        -mnemonic Q
  $parent.fileMenu.quit activateCallback exit

  $parent.menuBar.file setValues -subMenuId $parent.fileMenu

  return $parent.menuBar
}

#
# createPane
#
proc createPane {parent} {
  xmPanedWindow $parent.pane

  # create the executable files section
  xmForm $parent.pane.rc1 managed

  xmLabel $parent.pane.rc1.executableFilter managed \
    -topAttachment attach_form \
    -leftAttachment attach_form

  xmScrolledWindow $parent.pane.rc1.sw managed \
    -scrollingPolicy	automatic \
    -topAttachment attach_widget \
    -topWidget $parent.pane.rc1.executableFilter \
    -leftAttachment attach_form \
    -rightAttachment attach_form \
    -bottomAttachment attach_form

  xmRowColumn $parent.pane.rc1.sw.executablesPane managed

  $parent.pane.rc1.sw setValues \
    -workWindow $parent.pane.rc1.sw.executablesPane


  # create the ordinary files section
  xmForm $parent.pane.rc2 managed

  xmLabel $parent.pane.rc2.fileFilter managed \
    -topAttachment attach_form \
    -leftAttachment attach_form

  xmScrolledWindow $parent.pane.rc2.sw managed \
    -scrollingPolicy	automatic \
    -topAttachment attach_widget \
    -topWidget $parent.pane.rc2.fileFilter \
    -leftAttachment attach_form \
    -rightAttachment attach_form \
    -bottomAttachment attach_form

  xmRowColumn $parent.pane.rc2.sw.filesPane managed

  $parent.pane.rc2.sw setValues \
    -workWindow $parent.pane.rc2.sw.filesPane

  # create the directories section
  xmForm $parent.pane.rc3 managed

  xmLabel $parent.pane.rc3.dirFilter managed \
    -topAttachment attach_form \
    -leftAttachment attach_form

  xmScrolledWindow $parent.pane.rc3.sw managed \
    -scrollingPolicy	automatic \
    -topAttachment attach_widget \
    -topWidget $parent.pane.rc3.dirFilter \
    -leftAttachment attach_form \
    -rightAttachment attach_form \
    -bottomAttachment attach_form

  xmRowColumn $parent.pane.rc3.sw.dirsPane managed

  $parent.pane.rc3.sw setValues \
    -workWindow $parent.pane.rc3.sw.dirsPane


  return $parent.pane
}

#
# setGeometry
#
proc setGeometry {dirLabel filesToolbar dirsToolbar pane} {
  $dirLabel setValues \
    -topAttachment	attach_form \
    -leftAttachment	attach_form \
    -rightAttachment	attach_form

  $filesToolbar setValues \
    -topAttachment	attach_widget \
    -topWidget		$dirLabel \
    -leftAttachment	attach_form \
    -bottomAttachment	attach_position \
    -bottomPosition	45

  $dirsToolbar setValues \
    -topAttachment	attach_position \
    -topPosition	50 \
    -leftAttachment	attach_form \
    -bottomAttachment	attach_form

  $pane setValues \
    -topAttachment	attach_widget \
    -topWidget		$dirLabel \
    -leftAttachment	attach_widget \
    -leftWidget		$filesToolbar \
    -rightAttachment	attach_form \
    -bottomAttachment	attach_form
}

#######################################################################
#
# This section contains the callbacks for the various widgets
#
#######################################################################

#
# fileToolButtonPressed
#
proc fileToolButtonPressed {n} {
  global fileToolbarButtonAction
  global selectedFile

  set oldAction [lindex $fileToolbarButtonAction($n) 3]
  regsub -all {\$0} $oldAction $selectedFile newAction
  if { [regexp {^\$} $newAction] } {
    builtinCommand "$newAction"
  } else {
    set runInXterm [lindex $fileToolbarButtonAction($n) 0]
    set pauseAfterExec [lindex $fileToolbarButtonAction($n) 1]
    doCommand "$newAction" $runInXterm $pauseAfterExec
  }
}

#
# fileButtonPressed
#
proc fileButtonPressed {widget type} {
  global actions
  global fileToolbarButtons
  global fileToolbarButtonAction
  global FILES_TOOLBAR_SIZE
  global selectedFile
  global selectedWidget

  if {$selectedWidget != ""} {
    invertColours $selectedWidget unhighlight
  }
  $widget getValues -labelString file
  set selectedFile $file
  set selectedWidget $widget
  invertColours $selectedWidget highlight

  foreach f $actions {
    set t_def [lindex $f 0]
    if {$t_def != $type} continue
    set pattern [lindex $f 1]
    if { ! [string match $pattern $file] } continue
    # we have a match!

    set pixmap [lindex $f 2]
    set description [lindex $f 3]
    set acts [lindex $f 4]

    set m 0
    set length [llength $acts]
    while {$m < $length && $m < $FILES_TOOLBAR_SIZE} {
      set a [lindex $acts $m]
      $fileToolbarButtons($m) setValues \
        -labelString [lindex $a 2]
      $fileToolbarButtons($m) setSensitive true
      set fileToolbarButtonAction($m) $a
      incr m
    }

    # clear other buttons
    while {$m < $FILES_TOOLBAR_SIZE} {
      $fileToolbarButtons($m) setSensitive false
      $fileToolbarButtons($m) setValues \
	-labelString ""
      incr m
    }
    break
  }
}

#
# fileButtonReleased
#
proc fileButtonReleased {widget type} {
  $widget getValues -labelString file
}

#
# fileButtonExposed
#
proc fileButtonExposed {widget type} {
  global buttonsInfo

  $widget getValues -labelString file

  set fileInfo $buttonsInfo($widget)
  set filename [lindex $fileInfo 0]
  set gc [lindex $fileInfo 3]

  $widget getValues -height h
  $widget drawImageString $gc 0 [expr $h-5] $filename 
}

#######################################################################
#
# This section handles commands when they are selected
#
#######################################################################

#
# builtinCommand
#
proc builtinCommand {command} {

  if { [regexp {^\$cd} $command] } {
    set dirName [lindex $command 1]
    cd $dirName
    panelSetFiles .main.form.pane
  }
}

#
# doCommand
#   - this handles the non builtin commands
#
proc doCommand {command runInXterm pauseAfterExec} {

  if {$runInXterm && $pauseAfterExec} {
    set newCommand "xterm -e pauseme $command"
  } else {
    if {$runInXterm} {
      set newCommand "xterm -e $command"
    } else {
      set newCommand $command
    }
  }
  eval exec $newCommand < /dev/null &
}


#######################################################################
#
# this section handles the dynamic updating of files displayed in the
# various pane areas
#
#######################################################################

#
# pixmapOf
#  - find the pixmap for a filename
#
proc pixmapOf {file type} {
  global actions

  foreach f $actions {
    set t_def [lindex $f 0]
    if {$t_def != $type} continue
    set pattern [lindex $f 1]
    if { ! [string match $pattern $file] } continue
    # we have a match!

    set pixmap [lindex $f 2]
    return $pixmap
  }
}

#
# setGCs
#
proc setGCs {widget} {
  global gc gc_reversed

  $widget getValues -foreground fg -background bg
  set gc [$widget getGC -foreground $fg -background $bg]
  set gc_reversed [$widget getGC -foreground $bg -background $fg]
}

#
# newPaneButton
#
proc newPaneButton {parent n} {
  xmDrawnButton $parent.button$n managed \
    -labelType pixmap

  return $parent.button$n
}

#
# panelSetFiles
#  - the toplevel setter
#
proc panelSetFiles {panel} {
  global dirArray
  global fileArray
  global executableArray
  global buttonsInfo
  global gc
  global gc_reversed
  global firstTime

  set dirCount 0
  set fileCount 0
  set executableCount 0

  setGCs $panel

  # turn off unpleasant screen draws
  if { $firstTime != 0 } {
    $panel.rc1.sw.executablesPane unmapWidget
    $panel.rc2.sw.filesPane unmapWidget
    $panel.rc3.sw.dirsPane unmapWidget
  }

  set files [exec ls -a]
  foreach f $files {
    if { [file isdirectory $f] } {
      if { ! [info exists dirArray($dirCount)] } {
	set button \
		[newPaneButton $panel.rc3.sw.dirsPane $dirCount]
	$button armCallback {fileButtonPressed %w d}
	$button activateCallback {fileButtonReleased %w d}
	$button exposeCallback {fileButtonExposed %w d}
	set dirArray($dirCount) $button
      }
      set pixmap [pixmapOf $f d]

      $dirArray($dirCount) setValues \
        -labelPixmap $pixmap \
	-labelString $f 
      $dirArray($dirCount) manageChild

      set buttonsInfo($dirArray($dirCount)) \
		[list $f d $pixmap $gc $gc_reversed]
      incr dirCount

      continue
    }

    if { [file executable $f] } {
      if { ! [info exists executableArray($executableCount)] } {
        set button \
                [newPaneButton $panel.rc1.sw.executablesPane $executableCount]
	$button activateCallback {fileButtonReleased %w x}
	$button armCallback {fileButtonPressed %w x}
	$button exposeCallback {fileButtonExposed %w x}
	set executableArray($executableCount) $button
      }
      set pixmap [pixmapOf $f x]

      $executableArray($executableCount) setValues \
        -labelPixmap $pixmap \
        -labelString $f 
      $executableArray($executableCount) manageChild

      set buttonsInfo($executableArray($executableCount)) \
		[list $f d $pixmap $gc $gc_reversed]
      incr executableCount

      continue
    }

    if { ! [info exists fileArray($fileCount)] } {
      set button \
                [newPaneButton $panel.rc2.sw.filesPane $fileCount]
      $button armCallback {fileButtonPressed %w f}
	$button exposeCallback {fileButtonExposed %w f}
      $button activateCallback {fileButtonReleased %w f}
      set fileArray($fileCount) $button
    }
    set pixmap [pixmapOf $f f]

    $fileArray($fileCount) setValues \
      -labelString $f \
      -labelPixmap $pixmap
    $fileArray($fileCount) manageChild

    set buttonsInfo($fileArray($fileCount)) \
		[list $f d $pixmap $gc $gc_reversed]
    incr fileCount
  }

  # now we get to unmanage all the files that are still showing
  while { [info exists dirArray($dirCount)]} {
    $dirArray($dirCount) unmanageChild
    incr dirCount
  }
  while { [info exists executableArray($executableCount)]} {
    $executableArray($executableCount) unmanageChild
    incr executableCount
  }
  while { [info exists fileArray($fileCount)]} {
    $fileArray($fileCount) unmanageChild
    incr fileCount
  }

  # make this all visible again
  if { $firstTime != 0 } {
    $panel.rc1.sw.executablesPane mapWidget
    $panel.rc2.sw.filesPane mapWidget
    $panel.rc3.sw.dirsPane mapWidget
  }
  set firstTime 1
}

#######################################################################
#
# this section covers what happens when a file is selected in a pane
#
#######################################################################

#
# invertColours
#
proc invertColours {widget highlight} {
  global buttonsInfo
  
  set fileInfo $buttonsInfo($widget)
  set filename [lindex $fileInfo 0]
  set pixmap [lindex $fileInfo 2]
  set gc [lindex $fileInfo 3]
  set gc_reversed [lindex $fileInfo 4]
  set buttonsInfo($widget) \
	[lreplace $fileInfo 3 4 $gc_reversed $gc]

  # this is a roundabout route for inverting the
  # pixmap, because I cannot set the fg and bg
  # directly for it. may need to unmap to stop
  # unpleasant visual effects
  $widget getValues -foreground fg -background bg
  if {"$highlight" == "highlight"} {
    $widget unmapWidget
    $widget setValues -foreground $bg -background $fg
    $widget setValues -labelPixmap $pixmap
    $widget setValues -foreground $fg -background $bg
    $widget mapWidget
  } else {
    $widget setValues -labelPixmap $pixmap
  }

  # in xmfm this was XClearArea:
  $widget getValues -height h
  $widget drawImageString $gc_reversed 0 [expr $h-5] $filename 
}

#######################################################################
#
# this section handles parsing of the action specification file
#
#######################################################################

#
# loadActionsFile
#
proc loadActionsFile {} {
  global env

  if { [file exists xtmfmrc] } {
    source xtmfmrc
    return
  }
  set homeXtmfmrc $env(HOME)/.xtmfmrc
  if { [file exists $homeXtmfmrc] } {
    source $homeXtmfmrc
    return
  }
  if { [info exists env(XAPPRESDIR)] } {
    source $env(XAPPRESDIR)/xtmfmrc
    return
  }
  if { [file exists "/usr/lib/X11/app-defaults/xtmfmrc"] } {
    source "/usr/lib/X11/app-defaults/xtmfmrc"
    return
  }
  puts stderr "Can't find xtmfmrc file"
  exit 1
}

#
# load_actions
#  - parse the actions list and store it
#
proc loadActions {inActs} {
  global actions

  set actions {}
  foreach filetype $inActs {
    set next [addFileType $filetype]
    set actions [lappend actions $next]
  }
}

#
# fileAction
#  - parse the set of actions for an individual file type
#
proc fileAction {action} {
  set act(label) ""
  set act(run_in_xterm) 0
  set act(pause_after_exec) 0
  set act(action) ""
  set act(prompt) ""
  set act(confirm) ""

  set n 0
  set length [llength $action]
  while {$n < $length} {
    set item [lindex $action $n]
    case $item in {
      run_in_xterm 	{set act(run_in_xterm) 1}
      pause_after_exec	{set act(pause_after_exec) 1}
      label		{
			 incr n
			 set act(label) [lindex $action $n]
			}
      action		{
			 incr n
			 set act(action) [lindex $action $n]
			}
      prompt		{
			 incr n
			 set act(prompt) [lindex $action $n]
			}
      confirm		{
			 incr n
			 set act(confirm) [lindex $action $n]
			}
     default		{
			 puts stderr "unknown action $item"
			}
    }
    incr n
  }
  return [list $act(run_in_xterm) $act(pause_after_exec) \
			$act(label) $act(action) $act(prompt) $act(confirm)]
  
}

#
# parse the entry for a new filetype
#
proc addFileType {filetype} {
  set n 0
  set length [llength $filetype]
  
  set a(type) ""
  set a(pattern) ""
  set a(pixmap) ""
  set a(description) ""
  set a(actions) {}

  while {$n < $length} {
    set current [lindex $filetype $n]
    case $current in {
      type	{incr n
		 set a(type) [lindex $filetype $n]
		 incr n
		}
      pattern	{incr n
                 set a(pattern) [lindex $filetype $n]
                 incr n
                }
      pixmap	{incr n
                 set a(pixmap) [lindex $filetype $n]
                 incr n
                }
      description	{incr n
                	 set a(description) [lindex $filetype $n]
                	 incr n
                	}
      default	{
		 set a(actions) [lappend a(actions) [fileAction  $current]]
		 incr n 1
                }
    }
  }
  return [list $a(type) $a(pattern) $a(pixmap) $a(description) $a(actions)]
}

#######################################################################
#
# global commands to set this all going
#
#######################################################################



loadActionsFile

set selectedWidget ""
set firstTime 0

xtAppInitialize -class Xtmfm \
    -fallbackResources {
	{*main.width: 600}
	{*main.height: 600}

	{*filesToolbar*XmPushButton.height: 70}
	{*filesToolbar*XmPushButton.width: 70}
	{*filesToolbar*XmPushButton.recomputeSize: false}
	{*filesToolbar.entryAlignment: alignment_center}

	{*dirsToolbar*XmPushButton.height: 70}
	{*dirsToolbar*XmPushButton.width: 70}
	{*dirsToolbar*XmPushButton.recomputeSize: false}
	{*dirsToolbar.entryAlignment: alignment_center}

	{*XmDrawnButton.width: 100}
	{*XmDrawnButton.height: 70}
	{*XmDrawnButton.recomputeSize: false}
	{*XmDrawnButton.shadowThickness: 0}
	{*XmDrawnButton.borderWidth:     0}
	{*XmDrawnButton.highlightThickness:      0}

	{*executablesPane.packing: pack_column}
	{*executablesPane.orientation: vertical}
	{*executablesPane.numColumns: 4}

	{*dirsPane.packing: pack_column}
	{*dirsPane.orientation: vertical}
	{*dirsPane.numColumns: 4}

	{*filesPane.packing: pack_column}
	{*filesPane.orientation: vertical}
	{*filesPane.numColumns: 4}

	{*executableFilter.labelString: Filter *}
	{*fileFilter.labelString: Filter *}
	{*dirFilter.labelString: Filter *}
    }

createApplication

. realizeWidget
. mainLoop

