#
# TCL Library for TkCVS
#

#
# $Id: reports.tcl,v 1.22 2001/06/02 05:02:07 dorothyr Exp $
#
# Procedures for CVS reports.
#

proc screen_or_printer_setup { } {
#
# This sets up a dialog to determine whether a report should
# be put on the screen, printed, or saved to a file.
#
  global cvscfg
  global file_name
  global sorp
  global sorp_button

  gen_log:log T "ENTER"

  toplevel .sorp

  # Give the WM hints to position the dialog.  Otherwise it goes to some weird
  # place if the WM is trying to be extra-smart ala fvwm.
  set g [split [wm geometry .modbrowse] "+-x" ]
  set x [lindex $g 2]
  set y [lindex $g 3]
  incr x 150
  incr y 200
  wm geometry .sorp +${x}+${y}
  wm title .sorp "Select Report Destination"

  if {! [info exists file_name]} {
    set file_name "Report.txt"
  }

  frame .sorp.left
  frame .sorp.right
  frame .sorp.down -relief groove -border 2

  pack .sorp.down -side bottom -fill x
  pack .sorp.left -side left -fill y
  pack .sorp.right -side left -fill both -expand 1

  set sorp "Screen"
  radiobutton .sorp.rprinter -text "Printer" \
    -variable sorp -value "Printer" -anchor w
  radiobutton .sorp.rfile -text "File" \
    -variable sorp -value "File" -anchor w
  radiobutton .sorp.rscreen -text "Screen" \
    -variable sorp -value "Screen" -anchor w

  entry .sorp.tprinter -relief sunken -textvariable cvscfg(printer)
  entry .sorp.tfile -relief sunken -textvariable file_name

  pack .sorp.rprinter .sorp.rfile .sorp.rscreen -in .sorp.left \
    -side top -anchor w -fill x -pady 2
  pack .sorp.tprinter .sorp.tfile -in .sorp.right \
    -side top -fill x -pady 3

  button .sorp.ok -text "OK" -command { set sorp_button 1; wm withdraw .sorp }
  button .sorp.quit -text "Cancel" -command { set sorp_button 0; wm withdraw .sorp}

  pack .sorp.ok .sorp.quit -in .sorp.down -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  update idletasks
  gen_log:log T "LEAVE"
}

proc screen_or_printer_run { } {
  gen_log:log T "ENTER"

  if {! [winfo exists .sorp]} {
    screen_or_printer_setup
  }
  wm deiconify .sorp
  raise .sorp
  gen_log:log T "LEAVE"
}

proc viewer_setup { } {
  #
  # Set up a dialog containing a text box that can be used to view
  # the report on the screen.
  #
  gen_log:log T "ENTER"

  toplevel .viewer
  text .viewer.text -setgrid yes -yscroll {.viewer.scroll set} \
    -relief sunken -border 2
  scrollbar .viewer.scroll -command {.viewer.text yview} -relief sunken
  frame .viewer.bottom

  search_textwidget_init
  button .viewer.bottom.close -text "Close" -command { wm withdraw .viewer }
  button .viewer.bottom.srchbtn -text Search \
    -command "search_textwidget .viewer.text"
  entry .viewer.bottom.entry -width 20 -textvariable cvsglb(searchstr)
  bind .viewer.bottom.entry <Return> \
      "search_textwidget .viewer.text"

  pack .viewer.bottom -side bottom -fill x
  pack .viewer.scroll -side right -fill y
  pack .viewer.text -fill both -expand 1
  pack .viewer.bottom.srchbtn -side left
  pack .viewer.bottom.entry -side left
  pack .viewer.bottom.close -side right -ipadx 15

  wm withdraw .viewer
  wm title .viewer "Report"

  gen_log:log T "LEAVE"
}

proc modlist_by_code {dcode versions tagname} {
#
# This does all the hard work in creating the module listing
# Called by  Reports -> Module Tree and Version Tree
#
  global cvscfg
  global modtitle
  global dcontents
  global dparent
  global modlist_sorted
  global sorp
  global sorp_button
  global file_name
  global feedback

  gen_log:log T "ENTER ($dcode $versions $tagname)"
  if {$dcode == ""} {
    set dcode "."
  }
  # Ask them where they want the output to go.  Wait for the answer.
  # Bail out if they canceled.
  screen_or_printer_run
  tkwait variable sorp_button
  if {! $sorp_button} {
    gen_log:log T "LEAVE"
    return
  }

  if {$tagname == ""} {
    set tagname "HEAD"
  }
  feedback_cvs $feedback(mod) "Generating Report Please Wait"
  output_setup $sorp $file_name

  # If dcode is "." then report the entire tree.  Otherwise restrict
  # the report to a portion of the tree.
  if {$dcode == "."} {
    set modlist $modlist_sorted
  } else {
    set modlist [concat $dcode [find_subdirs $dcode 0]]
    gen_log:log D "$modlist"
  }
  foreach module $modlist {
    gen_log:log D "$module"
    set dname [lindex $module 0]
    if {[info exists modtitle($dname)]} {
      set title $modtitle($dname)
    }
    set leveltag firstlevel
    set leveltab ""
    set psfunc "postscript_heading"
    gen_log:log D "checking for dparent($dname)"
    if {[info exists dparent($dname)]} {
      gen_log:log D "parent $dparent($dname)"
      set leveltag sublevel
      set leveltab "  "
      set psfunc "postscript_subheading"
    }
    if {$sorp == "Screen"} {
      .viewer.text insert end "\n" $leveltag
      .viewer.text insert end "$dname\t$title\n" $leveltag
    } elseif {$sorp == "Printer"} {
      $psfunc $outfile "${leveltab}$title" $dname
    } else {
      puts $outfile "\n${leveltab}$dname\t${title}\n"
    }
    report_on_dir $dname $versions $tagname 0
  }

  # Finish the output
  if {$sorp == "Screen"} {
    .viewer.text tag configure firstlevel \
      -font "Helvetica $cvscfg(headingsize) bold"
    .viewer.text tag configure sublevel \
      -lmargin1 .5c \
      -font "Helvetica $cvscfg(subheadingsize) bold"
    .viewer.text tag configure leaflevel \
      -lmargin1 1c \
      -font "Helvetica $cvscfg(subheadingsize) bold"
    .viewer.text tag configure versionlevel \
      -lmargin1 1.5c \
      -font "Helvetica $cvscfg(pointsize)"
    .viewer.text configure -state disabled
    wm deiconify .viewer
    raise .viewer
  } elseif {$sorp == "Printer"} {
    postscript_end $outfile
    close $outfile
    gen_log:log F "lpr -P$cvscfg(printer) tkcvs.ps"
    exec $cvscfg(print_cmd) -P$cvscfg(printer) tkcvs.ps
    if {$cvscfg(logging) && [regexp -nocase {d} $cvscfg(log_classes)]} {
      gen_log:log D "Saved PS file as tkcvs.ps"
    } else {
      gen_log:log F "DELETE tkcvs.ps"
      file delete tkcvs.ps
    }
  } else {
    close $outfile
  }

  feedback_cvs $feedback(mod) ""
  gen_log:log T "LEAVE"
}

proc report_on_dir {dname versions tagname level} {
  global modtitle
  global modval
  global dcontents
  global sorp
  upvar outfile outfile

  gen_log:log T "ENTER ($dname $versions $tagname $level)"
  if {$versions} {
    if {[info exists modval($dname)]} {
      report_versions $dname $tagname
    }
  }
  if {[info exists dcontents($dname)]} {
    set title ""
    gen_log:log D "dcontents($dname) $dcontents($dname)"
    foreach mname $dcontents($dname) {
      set path [file join $dname $mname]
      if {[info exists modtitle($mname)]} {
        set title $modtitle($mname)
      }

      if {$level > 0} {
        if {[info exists modtitle($path)]} {
          set title $modtitle($path)
        }
      } else {
        # If it's not a leaf node, break out
        gen_log:log D "  looking for dcontents($path)"
        if {[info exists dcontents($path)]} {
          gen_log:log D "  found $dcontents($path)"
          return
        }
        gen_log:log D "  adding $mname leaf"
        if {$sorp == "Screen"} {
          .viewer.text insert end "$mname\t$title\n" leaflevel
        } elseif {$sorp == "Printer"} {
          postscript_line $outfile "          $title" $mname
        } else {
          puts $outfile "    $mname\t$title"
        }
        report_on_dir $mname $versions $tagname 1
      }
    }
  }

  gen_log:log T "LEAVE"
}

proc report_versions {mcode tagname} {
  global filenames
  global dcontents
  global cwd
  global sorp
  global cvs
  global cvscfg
  upvar outfile outfile

  gen_log:log T "ENTER ($mcode $tagname)"
  # If a list of files does not exist for this module, create it now.
  if {! [info exists filenames($mcode)]} {
    find_filenames $mcode
  }

  # Be careful of empty modules.
  if {! [info exists filenames($mcode)]} {
    gen_log:log D "didnt find any files in $mcode"
    return
  }

  set flags ""
  if {[info exists dcontents($mcode)]} {
    # If it has sub-modules, dont do a recursive listing because we'll be
    # doing the sub-module.
    append flags "-l"
  }
  if {$tagname !=""} {
    append flags " -r $tagname"
  }
  set commandline "$cvs -d $cvscfg(cvsroot) checkout $flags -p $mcode >$cvscfg(null)"
  gen_log:log C "$commandline"
  catch {eval "exec $commandline"} view_this

  set filelist ""
  set view_lines [split $view_this "\n"]
  foreach line $view_lines {
    if {[string match "Checking out *" $line]} {
      gen_log:log D "$line"
      set dname [lrange [split $line] 2 end]
      regsub "$mcode/" $dname "" fname
      gen_log:log D "$dname $fname"
      lappend filelist $fname
    }
    if {[string match "VERS:*" $line]} {
      gen_log:log D "$line"
      set ver [lindex [split $line] 1]
      set version($fname) $ver
    }
  }

  foreach fname $filelist {
    gen_log:log D "$fname"
    if {$sorp == "Screen"} {
      .viewer.text insert end "$fname\t\t$version($fname)\n" versionlevel
    } elseif {$sorp == "Printer"} {
      postscript_line $outfile "               $fname" "    $version($fname)"
    } else {
      puts $outfile "        $fname\t\t$version($fname)"
    }
  }

  gen_log:log T "LEAVE"
}

proc output_setup {sorp filename} {
# Called by modlist_by_code to see where output goes
  global cvsglb
  global cvscfg
  global sorp_button
  upvar outfile outfile

  gen_log:log T "ENTER ($sorp $filename)"
  if {! $sorp_button} {
    gen_log:log T "LEAVE (Canceled)"
    return
  }
  if {![info exists cvscfg(papersize)]} {
    set cvscfg(papersize) "A4"
  }
  if {$cvscfg(papersize) == "A4"} {
    set cvsglb(ystart) 770
    set cvsglb(yend) 60
    set cvsglb(xstart) 25
    set cvsglb(xend) 580
  } else {
    set cvsglb(ystart) 700
    set cvsglb(yend) 60
    set cvsglb(xstart) 25
    set cvsglb(xend) 580
  }

  if {$sorp == "Screen"} {
    if {! [winfo exists .viewer]} {
      viewer_setup
    }
    .viewer.text configure -state normal
    .viewer.text delete 1.0 end
  } elseif {$sorp == "Printer"} {
    gen_log:log F "OPEN tkcvs.ps"
    set outfile [open "tkcvs.ps" w]
    set cvsglb(ycurrent) $cvsglb(ystart)
    set cvsglb(pagenum) 1
    postscript_setup $outfile
  } else {
    gen_log:log F "OPEN $filename"
    set outfile [open $filename w]
  }
  gen_log:log T "LEAVE"
}

proc postscript_setup {outfile} {
  global cvsglb
  global cvscfg

  gen_log:log T "ENTER $outfile"
  set col1 [expr {$cvsglb(xend) * 0.55}]

  puts $outfile "%!PS-Adobe-2.0"
  puts $outfile "%%Title: module listing"
  puts $outfile "%%Creator: TkCVS"
  puts $outfile "%%DocumentFonts: Times-Roman"
  puts $outfile "%%ProofMode: Substitute"
  puts $outfile "%%Pages: (atend)"
  puts $outfile "%%EndComments"
  puts $outfile "%"
  puts $outfile "% Constants definition"
  puts $outfile "%"
  puts $outfile "/ystart $cvsglb(ystart) def"
  puts $outfile "/yend $cvsglb(yend) def"
  puts $outfile "/xstart $cvsglb(xstart) def"
  puts $outfile "/xend $cvsglb(xend) def"
  puts $outfile "/col1 $col1 def"
  puts $outfile "/div1 col1 xstart add 10 sub def"
  puts $outfile "/pointsize $cvscfg(pointsize) def"
  puts $outfile "/topsize $cvscfg(headingsize) def"
  puts $outfile "/subsize $cvscfg(subheadingsize) def"
  puts $outfile "/lineseparator pointsize 1 add def"
  puts $outfile "/textfont /Times-Roman findfont pointsize scalefont def"
  puts $outfile "/topfont /Helvetica findfont topsize scalefont def"
  puts $outfile "/subfont /Helvetica findfont subsize scalefont def"
  puts $outfile "/pagenum 1 def"
  puts $outfile "%"
  puts $outfile "% procedure definitions"
  puts $outfile "%"
  puts $outfile "/newpage"
  puts $outfile "  {"
  puts $outfile "   textfont setfont"
  puts $outfile "   /ycurrent ystart def"
  puts $outfile "   /xcurrent xstart def"
  puts $outfile "   (Module Name) col1 showtab"
  puts $outfile "   (Module Code) showln"
  puts $outfile "   () showln"
  puts $outfile "   /x1 xstart 5 sub def"
  puts $outfile "   /x2 xend def"
  puts $outfile "   /y1 ystart lineseparator add def"
  puts $outfile "   /y2 yend lineseparator 3 mul sub def"
  puts $outfile "   x1 y1 moveto"
  puts $outfile "   x2 y1 lineto"
  puts $outfile "   x2 y2 lineto"
  puts $outfile "   x1 y2 lineto"
  puts $outfile "   x1 y1 lineto"
  puts $outfile "   x1 ystart 2 sub moveto"
  puts $outfile "   x2 ystart 2 sub lineto"
  puts $outfile "   div1 y1 moveto"
  puts $outfile "   div1 y2 lineto"
  puts $outfile "   stroke"
  puts $outfile "   xstart ystart lineseparator 2 mul add moveto"
  puts $outfile "   (TkCVS     Module Listing             Page ) show"
  puts $outfile "   pagenum 10 string cvs show"
  puts $outfile "   /pagenum pagenum 1 add def"
  puts $outfile "  } def"
  puts $outfile "%"
  puts $outfile "/showtab"
  puts $outfile "  {"
  puts $outfile "   /xdelta exch def"
  puts $outfile "   xcurrent ycurrent moveto show"
  puts $outfile "   /xcurrent xcurrent xdelta add def"
  puts $outfile "  } def"
  puts $outfile "%"
  puts $outfile "/showtop"
  puts $outfile "  {"
  puts $outfile "   /xdelta exch def"
  puts $outfile "   topfont setfont"
  puts $outfile "   /ycurrent ycurrent topsize sub def"
  puts $outfile "   xcurrent ycurrent moveto show"
  puts $outfile "   /xcurrent xcurrent xdelta add def"
  puts $outfile "   xcurrent ycurrent moveto show"
  puts $outfile "   /ycurrent ycurrent lineseparator 2 mul sub def"
  puts $outfile "   /xcurrent xstart def"
  puts $outfile "   textfont setfont"
  puts $outfile "  } def"
  puts $outfile "%"
  puts $outfile "/showsub"
  puts $outfile "  {"
  puts $outfile "   /xdelta exch def"
  puts $outfile "   subfont setfont"
  puts $outfile "   /ycurrent ycurrent subsize sub def"
  puts $outfile "   xcurrent ycurrent moveto show"
  puts $outfile "   /xcurrent xcurrent xdelta add def"
  puts $outfile "   xcurrent ycurrent moveto show"
  puts $outfile "   /ycurrent ycurrent lineseparator 1.5 mul sub def"
  puts $outfile "   /xcurrent xstart def"
  puts $outfile "   textfont setfont"
  puts $outfile "  } def"
  puts $outfile "%"
  puts $outfile "/showln"
  puts $outfile "  {"
  puts $outfile "   xcurrent ycurrent moveto show"
  puts $outfile "   /ycurrent ycurrent lineseparator sub def"
  puts $outfile "   /xcurrent xstart def"
  puts $outfile "  } def"
  puts $outfile "%%EndProlog"
  puts $outfile "%"
  puts $outfile "% Start main program"
  puts $outfile "%"
  puts $outfile "%%Page: 1 1"
  puts $outfile "newpage"

  gen_log:log T "LEAVE"
}

proc postscript_line {outfile docname doccode} {
  global cvscfg
  global cvsglb

  gen_log:log T "ENTER ($outfile $docname $doccode)"
  puts $outfile "( $docname ) col1 showtab"
  puts $outfile "( $doccode ) showln"

  set cvsglb(ycurrent) [expr {$cvsglb(ycurrent) - $cvscfg(pointsize) - 1}]
  if {$cvsglb(ycurrent) < $cvsglb(yend)} {
    set cvsglb(ycurrent) $cvsglb(ystart)
    incr cvsglb(pagenum)
    puts $outfile "showpage"
    puts $outfile "%%Page: $cvsglb(pagenum) $cvsglb(pagenum)"
    puts $outfile "newpage"
  }
  gen_log:log T "LEAVE"
}

proc postscript_heading {outfile docname doccode} {
  global cvscfg
  global cvsglb

  gen_log:log T "ENTER ($outfile $docname $doccode)"
  puts $outfile "($doccode) ( $docname ) col1 showtop"

  set cvsglb(ycurrent) \
    [expr {$cvsglb(ycurrent) - $cvscfg(headingsize) - (2*$cvscfg(pointsize)) - 2}]
  if {$cvsglb(ycurrent) < $cvsglb(yend)} {
    set cvsglb(ycurrent) $cvsglb(ystart)
    incr cvsglb(pagenum)
    puts $outfile "showpage"
    puts $outfile "%%Page: $cvsglb(pagenum) $cvsglb(pagenum)"
    puts $outfile "newpage"
  }
  gen_log:log T "LEAVE"
}

proc postscript_subheading {outfile docname doccode} {
  global cvscfg
  global cvsglb

  gen_log:log T "ENTER ($outfile $docname $doccode)"
  puts $outfile "($doccode) ( $docname ) col1 showsub"

  set cvsglb(ycurrent) \
   [expr {$cvsglb(ycurrent) - $cvscfg(subheadingsize) - (2*$cvscfg(pointsize)) - 2}]
  if {$cvsglb(ycurrent) < $cvsglb(yend)} {
    set cvsglb(ycurrent) $cvsglb(ystart)
    incr cvsglb(pagenum)
    puts $outfile "showpage"
    puts $outfile "%%Page: $cvsglb(pagenum) $cvsglb(pagenum)"
    puts $outfile "newpage"
  }
  gen_log:log T "LEAVE"
}

proc postscript_end {outfile} {
  global cvsglb

  gen_log:log T "ENTER $outfile"
  puts $outfile "showpage"
  puts $outfile "%%Trailer"
  puts $outfile "%%Pages: $cvsglb(pagenum)"
  gen_log:log T "LEAVE"
}
