ftp.cs.arizona.edu/ftp.cs.arizona.edu.tar/ftp.cs.arizona.edu/icon/contrib/menu/xmenu.S

Text File | 1993-04-29 | 5KB | 190 lines

#
# xmenu.icn
# copyright 1992 Ronald Florence
# @(#) version 1.1 ([e-mail], 12 May 1992)
#
# main window:
#    left button to select recipe
#    q, ^c, ^d to quit
# recipe windows:
#    <space>, m, or left button for more
#    b or middle button for less
#    p to print
#    q or right button to return to main screen
# .Xdefaults options:
#    Xmenu.maxwin
#    Xmenu.index
#    Xmenu.datadir
#    Xmenu.font
# Configuration:
#    Maxwin :    maximum # of lines in the windows
#    indexfile:    full path of the indexfile
#    Data_dir:    full path of directory with recipe files
#    Font:        X-Windows display font
#    Print_cmd:    pretty-printer and/or spooler; the name of
#            the recipe will be substituted for %s
#

link evmux, button, xdefault
record rec_record (win, title, recipe, proc, but)
global Data_dir, Maxwin, Font, Print_cmd, R, W

procedure main(arg)
  local indexfile, pchar, hits, online, meta_keys, keys, xres,
        egrep_cmd, k, m, found, r, index, winsize, title, but

  "X Windows" == &features | stop("Sorry, requires X-Windows.")
  xres := xdefault("Xmenu")
  Maxwin := \xres["maxwin"] | %MAXWIN%
  indexfile := \xres["index"] | "%INDEXFILE%"
  Data_dir := \xres["datadir"] | "%DATADIR%"
  Font := \xres["font"] | "%FONT%"
  Print_cmd := "%PRINTCMD%"

  (*arg > 0) | stop("usage: menu keyword [keyword,...]")
  close(open(indexfile)) | stop("can't read indexfile")
  pchar := &ascii[32:127]
  hits := []
  online := []
  meta_keys := []
  keys := []
  egrep_cmd := "cat " || indexfile
  every k := !arg do put(if metas(k) then meta_keys else keys, map(k))
  \meta_keys[1] | put(meta_keys, pop(keys))
  every k := !meta_keys do egrep_cmd ||:= " | egrep -i '" || k || "'"
  index := open(egrep_cmd || " 2>&1", "rp")
  every !index ? {
    find("error"|"grep") & stop("search expression error")
    m := map(&subject)
    found := 1
    every k := !keys do { find(k, m) | break found := &null }
    \found & {
      put(if match("Comp-", &subject) then online else hits,
      left(tab(many(pchar)), 20) || (tab(upto(pchar)), tab(many(pchar))))
      tab(0)
    }
  }
  *hits + *online = 0 & stop("No matching recipes.")
  (winsize := *online * 2 + *hits + 1) <= Maxwin | {
    hits |||:= online
    online := []
    winsize := *hits + 1
  }
  winsize >=:= Maxwin
  W := open("menu", "x", "font=" || Font, "cursor=off", "lines=" || winsize,
        "columns=80") | stop("no window")
  quitsensor(W)
  if *hits > winsize then page(W, hits, "menu")
  else {
    every write(W, !hits)
   (*online > 0) | evhandle(W)
  }
  R := table()

  every !online ? {
    ="Comp-"
    r := tab(many(&digits))
    title := (tab(many(' \t')), tab(0))
    but := button(W, r, setup, r, XAttrib(W, "x"), XAttrib(W, "y"), 70, 20)
    XGotoRC(W, XAttrib(W, "row"), 21)
    write(W, title)
    R[r] := rec_record (&null, title, [], &null, but)
  }
  if *online > 0 then evmux(W)
end


procedure setup(win, r)
  local rpath, rf, heading

  if *R[r].recipe = 0 then {
    rpath := Data_dir || r
    rf := open(rpath) | open("zcat " || rpath || ".Z", "rp") |
    return writes("\^g")
    every put(R[r].recipe, !rf)
    close(rf)
  }
  if /R[r].win then {
    heading := R[r].title || " [" || r || "]"
    R[r].win := open(heading, "x", "font=" || Font, "cursor=off",
         "lines=" || (Maxwin > (*R[r].recipe + 2) | Maxwin),
         "columns=80") | stop("no page window")
    shadebutton(R[r].but)
    R[r].proc := create page(R[r].win, R[r].recipe, R[r].title)
  }
  @R[r].proc | (R[r].win := &null)
end


procedure page(win, rec, title)
  local base, x, k, i, e, lines

  lines := XAttrib(win, "lines")
  base := 0
  repeat {
    XClearArea(win)
    XGotoRC(win,1,1)
    every i := 0 to lines - 2 do {
      if i + base < *rec then writes(win, rec[i+base+1])
      write(win)
    }
    if lines = Maxwin then {
      XAttrib(win, "reverse=on")
      writes(win, "--More--(", ((100 > (base+lines-2) * 100/*rec) | 100), "%)")
      XAttrib(win, "reverse=off")
    }
    case (x := XActive()) of {
      win : &null
      W : @&main
      default: every k := key(R) do if (x === R[k].win) then break @R[k].proc
    }
    if type(e := XEvent(win)) == "integer" then XEvent(win)
    else e := map(e)
    case e of {
      " "|"m"|&lpress: base := *rec > (base+lines-2)
      "b"|&mpress: base := (0 < (base-lines+2) | 0)
      "q"|&rpress: close(win) & fail
      "p": print(rec, title)
    }
  }
end


procedure print(recipe, head)
  local prn, rp

  Print_cmd ? {
    prn := (\tab(find("%s")) || head) | tab(0)
    move(2) & prn ||:= tab(0)
  }
  rp := open(prn, "wp")
  every write(rp, !recipe)
  return close(rp)
end


procedure metas(str)

  str ? {
    tab(many('*+?|'))        # initials don't count
    while tab(upto('\\*+()|?.$^[')) do {
                # a naked backslash is NG
      if ="\\" then move(1) | stop("badly-formed search string")
      else return .&pos
    }
  }
  fail
end


procedure shadebutton(b)

  XAttrib(W, "fillstyle=opaquestippled")
  XSetStipple(W, 4, 10, 7, 5, 15)
  XFillRectangle(b.win, b.x+1, b.y+1, b.w-1, b.h-1)
  XGotoXY(b.win, b.lx, b.ly)
  writes(b.win, b.label)
end