SeminarMatching: Shiny App for Seminar Assignment

examples.StudSeminarsApp = function() {
  setwd("D:/libraries/SeminarMatching/semapps/shared")
  restore.point.options(display.restore.point = TRUE)
  app = StudSeminarsApp(init.userid = "sebastian.kranz@uni-ulm.de", init.password="umulz", lang="en",smtp = list(from = "seminars@email.de",host.name = "localhost"), pure.random.order.prob = 1)

  viewApp(app)
}


StudSeminarsApp = function(db.dir = paste0(main.dir,"/db"), schema.dir = paste0(main.dir,"/schema"), yaml.dir =  paste0(main.dir,"/yaml"), rmd.dir = paste0(main.dir,"/rmd"), main.dir=getwd(),   init.userid="", init.password="", app.title="Uni Ulm WiWi Seminar Selection", app.url = "http://localhost", email.domain = "uni-ulm.de", check.email.fun=NULL, email.text.fun=default.email.text.fun, use.db=TRUE, main.header=NULL, smtp=NULL, lang="en", userid.label="Userid (Email)", password.label = "Password", stud.log.file = paste0("studlog_", year(Sys.Date()),".txt"), pure.random.order.prob = 0.5) {
  restore.point("StudSeminarsApp")

  library(loginPart)
  library(RSQLite)
  library(DBI)

  app = eventsApp()

  glob = app$glob

  glob$stud.log.file = stud.log.file
  glob$pure.random.order.prob = pure.random.order.prob

  glob$schemas = load.and.init.schemas(paste0(schema.dir, "/semdb.yaml"))
  glob$semdb = dbConnect(dbname=paste0(db.dir,"/semDB.sqlite"), drv = SQLite())

  glob$main.dir = main.dir
  glob$yaml.dir = yaml.dir
  glob$rmd.dir = rmd.dir
  glob$schema.dir = schema.dir
  glob$db.dir = db.dir

  glob$sets = read.yaml(file =paste0(yaml.dir,"/sets.yaml"), utf8 = TRUE)


  glob$fun.env = new.env()
  fun.file = paste0(main.dir,"/r/studsem_fun.R")
  if (file.exists(fun.file)) {
    source(file = fun.file, glob$fun.env)
  }

  rmd.names = c("pre","post","round1","round2")
  rmd.names = c(
    paste0("studseminfo_",rmd.names),
    paste0("stud_overview_",rmd.names),
    paste0("studsem_help"),
    "studtopics"
  )

  glob$rmd.li = lapply(rmd.names, function(rmd.name) {
    file = paste0(glob$rmd.dir,"/",rmd.name,"_",lang,".Rmd")
    compile.rmd(file, out.type="shiny",use.commonmark = TRUE, fragment.only = TRUE)
  })
  names(glob$rmd.li) = rmd.names


  glob$opts = opts = read.yaml(file=paste0(yaml.dir,"/settings.yaml"),keep.quotes = FALSE)
  glob$use_joker = isTRUE(opts$use_joker)

  texts = read.yaml(file=paste0(yaml.dir,"/texts.yaml"),keep.quotes = FALSE)
  glob$texts = lapply(texts,function(text) text[[lang]])


  # Set date format
  dateFormat = glob$texts[["dateFormat"]]
  .GlobalEnv$knit_print.Date =  function(x,...) {
    format(x, format="%a. %d.%m.%Y")
  }

  app$opts = glob$opts
  app$lang = lang

  form = load.and.init.form(file=paste0(yaml.dir,"/studform.yaml"), lang=lang, prefix="studform_")
  #form.schema.template(form)

  form$sets = glob$sets
  glob$studform = form

  logindb.arg = list(dbname=paste0(db.dir,"/loginDB.sqlite"),drv=SQLite())

  login.fun = function(app=getApp(),userid,...) {
    app$se = refresh.stud.app.data(userid=userid,se=NULL)
    ui = tabsetPanel(
      id = "studTabsetPanel",
      tabPanel(title = app$glob$texts$studoverviewTab, value="overviewPanel", uiOutput("overviewUI")),
      tabPanel(title = app$glob$texts$studstudTab, value="studPanel", uiOutput("studformUI")),
      tabPanel(title = app$glob$texts$studsemTab, value="semPanel", uiOutput("studsemUI")),
      #tabPanel(title = app$glob$texts$studtopicTab, value="topicPanel", uiOutput("studtopicsUI")),
      tabPanel(title = app$glob$texts$studhelpTab, value="helpPanel", uiOutput("studhelpUI"))

    )
    setUI("studMainUI", ui)
    show.stud.overview.ui()
    show.stud.form.ui()
    show.stud.sem.ui()
    show.stud.topics.ui()
    show.stud.help.ui()
    write.stud.log("login")
  }

  if (is.null(check.email.fun)) {
    if (!is.null(email.domain)) {
      check.email.fun = function(email, ...) {
        check.email.domain(email,domain = email.domain)
      }
    } else {
      check.email.fun = function(email,...) {
        list(ok=TRUE,msg="")
      }
    }
  }


  lop = loginPart(db.arg = logindb.arg, login.fun=login.fun, check.email.fun=check.email.fun, email.text.fun = email.text.fun, app.url=app.url, app.title=app.title,init.userid=init.userid, init.password=init.password,container.id = "studMainUI", smtp=smtp)
  lop$login$userid.label = glob$texts$useridLabel
  lop$login$password.label = glob$texts$passwordLabel
  lop$login$login.title = glob$texts$loginTitle
  lop$login$login.help = glob$texts$loginHelp


  set.lop(lop)
  lop.connect.db(lop=lop)
  lop$login$ui = lop.login.ui(lop)
  #lop$smtp = lop.get.smtp()

  appInitHandler(function(session,...) {

    initLoginDispatch(lop)
  })

  app$ui = tagList(
    fluidPage(
      uiOutput("studMainUI")
    )
  )

  js = '
  $(document).on("mousedown","#allSemTable a",function(){
  var td = $(this).closest("td");
  var row = $(td).data("row");
  Shiny.onInputChange("seminarLinkClick", {eventId: "seminarLinkClick", id: "seminarLinkClick", value: row, table: "allSem", nonce: Math.random()});
});
  $(document).on("mousedown","#selSemTable a",function(){
  var td = $(this).closest("td");
  var row = $(td).data("row");
  Shiny.onInputChange("seminarLinkClick", {eventId: "seminarLinkClick", id: "seminarLinkClick", value: row, table: "selSem", nonce: Math.random()});
});
  '
  shinyEvents::eventHandler(eventId="seminarLinkClick",fun = stud.seminar.link.click, jscript = js)

  app$lop = lop
  app
}

load.student.from.db = function(userid=se$userid, semester=NULL, app=getApp(), se=app$se) {
  restore.point("load.student.from.db")

  all = dbGet(se$db,"students",list(userid=userid),
    schema=app$glob$schemas$students)

  if (NROW(all)==0) return(list(userid=userid, email=userid, semester=se$semester, random_points=runif(1,0,10)))

  .sem = semester
  stud = filter(all, semester==.sem)
  if (NROW(stud)>0) {
    se$stud.exists = TRUE
    se$stud = stud
    return(stud)
  }

  sem.num = get.sem.number(all$semester)
  .sem = all$semester[which.max(sem.num)]
  stud = filter(all, semester==.sem)[1,]

  # redraw random points for this semester

  if (is.na(stud$random_points))
    stud$random_points=5

  if (isTRUE(app$opts$random_points_negative_autocor)) {
    # give a bonus if last time random points were below 5
    if (stud$random_points < 5) {
      stud$random_points = runif(1,5-stud$random_points,10)
    # give a malus if last time random points were above 5
    } else {
      stud$random_points = runif(1,0,15-stud$random_points)
    }
  } else {
    stud$random_points = runif(1,0,10)
  }

  c(stud$random_points, se$random_seed)
  se$stud.exists = FALSE
  se$stud = stud
  return(stud)
}

refresh.stud.app.data = function(userid=se$userid, se=NULL, app=getApp()) {
  restore.point("refresh.stud.app.data")

  if (is.null(se)) {
    se = new.env()
    se$db = app$glob$semdb
    se$userid = userid
  }
  app$se = se
  semester = get.default.semester(se=se)
  if (is.null(semester)) {
    semester = app$glob$sets$semesters[1]
  }
  se$semester = semester
  se$use_joker = app$glob$use_joker

  se$stud = load.student.from.db(userid=userid, semester=semester,se=se)

  se$seminars = dbGet(se$db,"seminars",list(semester=semester,active=TRUE),schema=app$glob$schemas$seminars)
  if (NROW(se$seminars) > 0) {
    se$seminars = mutate(se$seminars, free_slots = slots-filled_slots, filled=free_slots <= 0)

    # sort seminars
    if (!is.null(app$opts$allSemSort)) {
      se$seminars = arrange_(se$seminars, .dots = app$opts$allSemSort)
    }

  }
  se$studpref = dbGet(se$db,"studpref", list(userid=userid, semester=semester), schema=app$glob$schemas$studpref, orderby="pos ASC")


  admin = dbGet(se$db,"admin",nlist(semester=semester),schema=app$glob$schemas$admin)
  se$admin = init.se.admin(admin)
  se$round = se$admin$selection.round

  se$studmode = se$admin$studmode

  # Select the assigned seminars of the student
  sql = "
  SELECT * FROM assign
  NATURAL LEFT JOIN semtopic
  NATURAL LEFT JOIN seminars
  WHERE (assign.userid = :userid AND
        assign.semester = :semester)
  "
  se$stud_sems = dbGet(se$db, sql=sql, params=nlist(semester, userid))

  # Remove already assigned seminars
  if (NROW(se$stud_sems)>0) {
    se$seminars = se$seminars[! se$seminars$semid %in% se$stud_sems$semid,]
    se$studpref = se$studpref[! se$studpref$semid %in% se$stud_sems$semid,]

  }

  semids = se$stud_sems$semid

  se
}

show.stud.form.ui = function(se=app$se, app=getApp()) {

  restore.point("show.stud.form.ui")

  glob = app$glob
  form = glob$studform
  form.vals = form.default.values(glob$studform,values = se$stud)
  form.ui = form.ui.simple(glob$studform, values=form.vals,add.submit = TRUE)
  clear.form.alert(form=form)

  add.form.handlers(form,success.handler = save.studform)


  ui = c(list(HTML(app$glob$texts$profileIntro)), form.ui)
  setUI("studformUI", ui)

}



save.studform = function(values, app=getApp(), se=app$se,...) {
  restore.point("save.studForm")

  #schema.template(values, "students")
  form = app$glob$studform

  se$stud[names(values)] = values
  se$stud$semester = se$semester
  se$stud$userid = se$userid


  old.stud.exists = isTRUE(se[["stud.exists"]])
  dbWithTransaction(se$db,{
    dbInsert(se$db,"students", se$stud,mode = if (old.stud.exists) "replace" else "insert", schema=app$glob$schemas$students)
  })
  se$stud.exists = TRUE

  show.form.alert(form=form,msg=form$texts$submitSuccess, color=NULL)
  if (!old.stud.exists) {
    show.stud.sem.ui(se=se)
  }
}

show.stud.overview.ui = function(se=app$se, app=getApp()) {
  restore.point("show.stud.overview.ui")

  studmode = se$studmode

  envir = c(se$admin, list(stud_sems = se$stud_sems,stud.exists=se$stud.exists))
  cr = app$glob$rmd.li[[paste0("stud_overview_",studmode)]]
  header = render.compiled.rmd(cr, envir=envir)
  ui = fluidRow(column(offset=1, width=10,
    header
  ))
  setUI("overviewUI", ui)

}

assigned.sems.table = function(stud_sems=se$stud_sems,cols=c("semname","teacher"), header=cols, topic.header="topic",topic.choice.label="Choose Topic",se=app$se, app=getApp()) {

  restore.point("assigned.sems.table")
  cols = unique(c(cols,"topic"))
  header = c(header, topic.header)

  df = stud_sems[,cols, drop=FALSE]

  df$semname = as.weblink(link=stud_sems$weblink, label=df$semname)

  topicBtns = extraSmallButtonVector(id=paste0("topicBtn",1:NROW(df)),label=topic.choice.label)
  rows = is.na(stud_sems$topic) & !is.na(stud_sems$topics_date)
  df$topic[rows] = topicBtns[rows]
  rows = is.na(df$topic)
  df$topic[rows] = "---"

  html.table(df,header = header,bg.color = "#ffffff")
}

as.weblink = function(link, label, target=' target="_blank"') {
  restore.point("as.weblink")

  if (length(link)==0) return(NULL)
  has.link = nchar(link) > 0
  str = paste0("<a href='",link,"'",target,">",label,"</a>")
  str[!has.link] = label[!has.link]
  str
}

copy.round1.studpref = function(...,studpref=se$studpref,se=app$se, app=getApp()) {
  restore.point("copy.round1.studpref")

  r1 = filter(studpref, round==1)
  r2 = mutate(r1, round=2)
  se$studpref = rbind(r1,r2)

  compute.sem.df(se=se)

  show.selsem.table(se=se)
  show.sem.table(se=se)
  save.studpref()
}

show.stud.sem.ui = function(se=app$se, app=getApp()) {
  restore.point("show.stud.sem.ui")

  if (NROW(se$seminars)==0) {
    setUI("studsemUI", p("No seminars registered for the current semester"))
    return()
  }
  if (!isTRUE(se[["stud.exists"]])) {
    setUI("studsemUI", p(app$glob$texts$firstEnterData))
    return()
  }

  compute.sem.df(se=se)
  studmode = se$studmode

  envir = c(se$admin, nlist(stud_sems=se$stud_sems, stud.exists=se$stud.exists,se=se))
  cr = app$glob$rmd.li[[paste0("studseminfo_",studmode)]]
  ui = render.compiled.rmd(cr, envir=envir,out.type = "shiny",fragment.only = TRUE)

  buttonHandler("saveStudprefBtn",save.studpref)
  buttonHandler("copyStudprefBtn",copy.round1.studpref)
  add.studpref.handlers(num.sems=NROW(se$sem.df))

  setUI("studsemUI", ui)
  show.selsem.table(se=se)
  show.sem.table(se=se)

}

compute.sem.df = function(se=app$se, app=getApp(), opts=app$opts) {
  restore.point("compute.sem.df")

  studmode = se$studmode
  if (studmode=="round2")  {
    round = 2
  } else {
    round = 1
  }
  studpref = se$studpref[se$studpref$round==round,,drop=FALSE]

  sems = se$seminars
  sems = sort.shown.seminars(se=se,seminars=sems,random.prob = app$glob$pure.random.order.prob)


  cols = c("semid",intersect(unique(c("weblink", opts$selSemCols,opts$allSemCols)),colnames(sems)),"filled")
  sem.df = sems[,cols]




  # Add links to seminar titles
  if ("weblink" %in% colnames(sems)) {
    sem.df$semname = as.weblink(link = sems$weblink,label = sem.df$semname)
  }

  sem.df$selected = FALSE
  sem.df$row = 1:NROW(sem.df)
  sem.df$pos = NA
  sem.df$joker = 0

  if (NROW(studpref)>0) {
    sel.rows = match(studpref$semid, sem.df$semid)
    sel.rows = na.omit(sel.rows)
    if (length(sel.rows)>0) {
      sel.df = sem.df[sel.rows,]
      sel.df$pos = 1:NROW(sel.df)
      sel.df$joker = studpref$joker
      sem.df$selected[sel.rows] = TRUE
    } else {
      sel.rows = integer(0)
      sel.df = sem.df[sel.rows,]
    }
  } else {
    sel.rows = integer(0)
    sel.df = sem.df[sel.rows,]
  }

  se$sem.df = sem.df
  se$sel.df = sel.df
}


show.selsem.table = function(sel.df=se$sel.df, sel.row=NULL, app=getApp(), se=app$se, opts=app$opts,  header = app$glob$texts$selSemColnames, cols=app$opts$selSemCols) {
  restore.point("show.selsem.table")

  if (NROW(sel.df)==0) {
    setUI("selSemUI",p("---"))
    return()
  }

  widget.df = sel.widgets.df(sel.df, cols=cols)

  if (!app$glob$use_joker) {
    header = setdiff(header, c("joker","Joker"))
  }

  bg.color = ifelse(sel.df$filled,"#cccccc", "#ffffff")

  html = html.table(id="selSemTable",widget.df,sel.row = sel.row, header=header, bg.color=bg.color)

  setUI("selSemUI",HTML(html))

}


sel.widgets.df = function(df, cols=app$opts$selSemCols, app=getApp()) {
  restore.point("sel.widgets.df")

  rows = 1:NROW(df)
  upBtnId = paste0("upBtn_",rows)
  downBtnId = paste0("downBtn_",rows)
  removeBtnId = paste0("removeBtn_",rows)
  jokerBtnId = paste0("jokerBtn_",rows)

  upBtns = extraSmallButtonVector(id=upBtnId,label="",icon=icon("arrow-up",lib = "glyphicon"))
  downBtns = extraSmallButtonVector(id=downBtnId, label="",icon=icon("arrow-down",lib="glyphicon"))
  removeBtns = extraSmallButtonVector(id=removeBtnId, label="",icon=icon("remove",lib = "glyphicon"))

  if (app$glob$use_joker) {
    jokerBtns = extraSmallButtonVector(id=jokerBtnId, label="",icon=icon("star-empty",lib = "glyphicon"))

    srows = which(df$joker>0)
    if (length(srows)>0) {
      jokerBtns[srows] = extraSmallButtonVector(id=jokerBtnId[srows], label="",icon=icon("star",lib = "glyphicon"))
    }

  }

  btns = paste0(upBtns,downBtns,removeBtns)

  # # Add weblink
  # if ("semname" %in% cols & has.col(df,"weblink")) {
  #   has.link = nchar(df$weblink) >0
  #   df$semname[has.link] = paste0("<a href='",df$weblink,"' target = '_blank'>",df$semname,"<a>")[has.link]
  # }

  if (app$glob$use_joker) {
    data.frame(Rank=rows,Joker =jokerBtns, btns,df[,cols])
  } else {
    data.frame(Rank=rows, btns,df[,cols])
  }
}


show.sem.table = function(sem.df=se$sem.df, sel.rows=which(sem.df$selected), app=getApp(), se=app$se, header=app$glob$texts$allSemColnames, cols=app$opts$selSemCols) {
  restore.point("show.sem.table")

  sem.df$selected[sel.rows] = TRUE

  se$sem.df = sem.df


  bg.color = ifelse(sem.df$filled,"#cccccc", "#ffffff")
  widget.df = sem.widgets.df(sem.df, cols=cols)
  html =   html.table(id="allSemTable",widget.df,sel.row = sel.rows,header=header , bg.color=bg.color, sel.color="#aaffaa")
  setUI("allSemUI",HTML(html))
}


sem.widgets.df = function(df, cols=app$opts$selSemCols, app=getApp()) {
  restore.point("sem.widgets.df")
  rows = 1:NROW(df)

  # # Add weblink
  # if ("semname" %in% cols & has.col(df,"weblink")) {
  #   has.link = nchar(df$weblink) >0
  #   df$semname[has.link] = paste0("<a href='",df$weblink,"' target = '_blank'>",df$semname,"<a>")[has.link]
  # }

  addBtnId = paste0("addBtn_",rows)
  addBtns = extraSmallButtonVector(id=addBtnId,label="",icon=icon("plus",lib = "glyphicon"))
  addBtns[df$selected] = ""
  btns = paste0(addBtns)
  data.frame(row=rows,buttons=btns,df[,cols])
}


add.studpref.handlers = function(num.sems) {
  rows = 1:num.sems
  upBtnId = paste0("upBtn_",rows)
  downBtnId = paste0("downBtn_",rows)
  removeBtnId = paste0("removeBtn_",rows)
  addBtnId = paste0("addBtn_",rows)
  jokerBtnId =  paste0("jokerBtn_",rows)
  for (row in rows) {
    buttonHandler(upBtnId[row],updown.click, row=row,up=TRUE)
    buttonHandler(downBtnId[row],updown.click, row=row,up=FALSE)
    buttonHandler(addBtnId[row],add.seminar.click, row=row)
    buttonHandler(removeBtnId[row],remove.seminar.click, pos=row)
    buttonHandler(jokerBtnId[row],joker.seminar.click, pos=row)
  }
}


updown.click = function(app=getApp(),value,row,up=TRUE,se=app$se,...) {
  sel.df = se$sel.df
  restore.point("updown.click")
  cat("updown.click")

  semid = sel.df$semid[row]
  old.pos = row
  new.pos = row + 1.5 - 3*up
  sel.df$pos[row] = new.pos
  sel.df = sel.df[order(sel.df$pos),]
  new.row = which(sel.df$pos==new.pos)
  sel.df$pos = rank(sel.df$pos)
  se$sel.df = sel.df
  show.selsem.table(sel.df, sel.row=new.row)
  show.field.alert(msg=app$glob$texts$rankingNotYetSaved,id="studSemAlert")

  if (up>0) {
    write.stud.log("rank_up", list(semid=semid, old_pos=old.pos))
  } else {
    write.stud.log("rank_down", list(semid=semid, old_pos=old.pos))
  }

}

add.seminar.click = function(row, app=getApp(),se=app$se,...) {
  restore.point("add.seminar.click")
  cat("\nadd seminar click")
  # Seminar does already exist
  if (row %in% se$sel.df$row) return()
  #
  se$sel.df = rbind(se$sel.df,se$sem.df[row,])
  se$sel.df$pos = 1:NROW(se$sel.df)
  se$sem.df$selected[row] = TRUE

  show.selsem.table(se=se,sel.row = NROW(se$sel.df))
  show.sem.table(se=se)
  show.field.alert(msg=app$glob$texts$rankingNotYetSaved,id="studSemAlert",color = "red")

  semid = se$sem.df$semid[row]
  write.stud.log("add_sem", list(semid=semid, pos=NROW(se$sel.df)))

}

remove.seminar.click = function(pos,app=getApp(),se=app$se,...) {
  restore.point("remove.seminar.click")
  cat("\nremove seminar click")

  sem.df = se$sem.df
  sel.df = se$sel.df
  #
  row = sel.df$row[pos]

  sel.df = sel.df[-pos,]
  rows = sel.df$pos > pos
  sel.df$pos[rows] = sel.df$pos[rows]-1

  semid = sem.df$semid[row]
  sem.df$selected[row] = FALSE
  se$sem.df = sem.df
  se$sel.df = sel.df

  show.selsem.table(se=se,sel.row = NULL)
  show.sem.table(se=se)
  show.field.alert(msg=app$glob$texts$rankingNotYetSaved,id="studSemAlert",color = "red")

  write.stud.log("remove_sem", list(semid=se$sem.df$semid[row], pos=pos))
}


joker.seminar.click = function(pos,app=getApp(),se=app$se,...) {
  restore.point("joker.seminar.click")

  if (sel.df$joker[pos]) {
    se$sel.df$joker[pos] = FALSE
  } else {
    se$sel.df$joker = FALSE
    se$sel.df$joker[pos] = TRUE
  }
  show.selsem.table(se=se,sel.row = NULL)
  show.field.alert(msg=app$glob$texts$rankingNotYetSaved,id="studSemAlert",color = "red")
}

save.studpref = function(app=getApp(), se=app$se,...) {
  restore.point("save.stud.prefs")

  fun.env = app$glob$fun.env

  if (!is.null(fun.env$check.studsem)) {
    check = fun.env$check.studsem(se=se, student=se$stud, sems=se$sel.df, lang=app$lang)
  } else {
    check = list(ok = TRUE, msg=app$glob$texts$rankingSaveSuccess)
  }
  if (!check$ok) {
    show.field.alert(msg=check$msg,id="studSemAlert",color="red")
    return()
  }

  dbBegin(se$db)
  dbDelete(se$db, "studpref",list(userid=se$userid, semester=se$semester, round=se$round))

  if (NROW(se$sel.df)>0) {
    sel.df = arrange(se$sel.df,pos)
    studpref = data_frame(semid=se$sem.df$semid[sel.df$row], userid=se$userid,semester=se$semester, pos=sel.df$pos, joker=sel.df$joker, round=se$round)
    dbInsert(se$db, "studpref",studpref, schema=app$glob$schemas$studpref)

    write.stud.log("save_prefs", list(semid=studpref$semid, pos=studpref$pos))
  } else {
    write.stud.log("save_empty_prefs")
  }
  dbCommit(se$db)
  show.field.alert(msg=check$msg,id="studSemAlert",color="black")


}

max.date = function(vals) {
  m = suppressWarnings(max(vals, na.rm=TRUE))
  if (!is.finite(m)) m = as.Date(NA)
  m
}

show.stud.topics.ui = function(se=app$se, app=getApp()) {
  restore.point("show.stud.topics.ui")
  setUI("studtopicsUI", HTML("Seminar topics cannot yet be assigned with this software."))
  return()

  stud_sems = se$stud_sems

  if (NROW(stud_sems)==0) {
    setUI("studtopicsUI", HTML("You have no seat in a seminar that allows to select topics with this software."))
    return()
  }

  cr = app$glob$rmd.li[["studtopics"]]

  tab.panels = lapply(1:NROW(stud_sems), function(i) {
    restore.point("inner.show.stud.topics.ui")
    sem = stud_sems[i,]
    envir = list(sem = sem, semid=sem$semid)
    content = render.compiled.rmd(cr, envir=envir)
    tabPanel(title=sem$semname,value=sem$semid, tagList(content))
  })

  #ts = tabsetPanel(id="topicsTabset",tab.panels,value=stud_sems$semid[1])
  ts = do.call("tabsetPanel",c(list(id="topicsTabset"),tab.panels))
  setUI("studtopicsUI",ts)

  for (i in 1:NROW(stud_sems)) {
    sem = stud_sems[i,]
    show.sel.topics.table(semid = sem$semid,se = se)
    show.all.topics.table(semid = sem$semid,se = se)
    add.topic.handlers(semid=sem$semid, num.topics=NROW(se$semtopics[[i]]))
  }

}


show.sel.topics.table = function(semid, use.points=FALSE, se=app$se, app=getApp(), cols="topic", header=NULL, sel.row=NULL) {
  restore.point("show.sel.topics.table")

  df = se$seltopics[[as.character(semid)]]
  ui.id = paste0("selTopicsTableUI_",semid)

  if (is.null(cols)) {
    cols = colnames(df)
  }

  if (NROW(df)==0) {
    setUI(ui.id,p("---"))
    return()
  }

  rows = 1:NROW(df)
  upBtnId = paste0("upBtn_",rows,"__",semid)
  downBtnId = paste0("downBtn_",rows,"__",semid)
  removeBtnId = paste0("removeBtn_",rows,"__",semid)
  pointsId = paste0("pointsInput_",rows,"__",semid)

  upBtns = extraSmallButtonVector(id=upBtnId,label="",icon=icon("arrow-up",lib = "glyphicon"))
  downBtns = extraSmallButtonVector(id=downBtnId, label="",icon=icon("arrow-down",lib="glyphicon"))
  removeBtns = extraSmallButtonVector(id=removeBtnId, label="",icon=icon("remove",lib = "glyphicon"))

  if (use.points) {
    pointsInp = textInputVector(inputId=pointsId,label="",value = df$points, style="width: 4em;")
  }

  btns = paste0(upBtns,downBtns,removeBtns)
  if (use.points) {
    wdf = data.frame(Rank=rows, btns,Points =pointsInp,df[,cols])
  } else {
    wdf = data.frame(Rank=rows, btns,df[,cols])
  }

  if (is.null(header)) {
    header = colnames(wdf)
    header[2] = ""
  }

  html = html.table(wdf,sel.row=sel.row, header=header, bg.color="#ffffff")

  setUI(ui.id,HTML(html))


}


show.all.topics.table = function(semid, se=app$se, cols="topic", header = NULL, app=getApp()) {

  restore.point("show.all.topic.table")

  sel.df = se$seltopics[[as.character(semid)]]
  all.df = se$semtopics[[as.character(semid)]]
  ui.id = paste0("allTopicsTableUI_",semid)

  if (NROW(all.df)==0) {
    setUI(ui.id,p("---"))
    return()
  }

  if (is.null(cols))
    cols = colnames(all.df)

  if (is.null(header))
    header = cols

  sel.rows = match(sel.df$topic_ind, all.df$topic_ind)

  rows = 1:NROW(all.df)
  addBtnId = paste0("addTopicBtn_",semid,"_",rows)
  addBtns = extraSmallButtonVector(id=addBtnId,label="",icon=icon("plus",lib = "glyphicon"))
  addBtns[sel.rows] = ""
  btns = paste0(addBtns)
  widget.df = data.frame(row=rows,buttons=btns,all.df[,cols])

  html =   html.table(widget.df,sel.row = sel.rows,header=header , bg.color="#ffffff", sel.color="#aaffaa")
  setUI(ui.id,HTML(html))
}

add.topic.handlers = function(semid, num.topics) {
  rows = 1:num.topics
  addBtnId = paste0("addTopicBtn_",semid,"_",rows)
  upBtnId = paste0("upBtn_",rows,"__",semid)
  downBtnId = paste0("downBtn_",rows,"__",semid)
  removeBtnId = paste0("removeBtn_",rows,"__",semid)
  pointsId = paste0("pointsInput_",rows,"__",semid)

  for (row in rows) {
    buttonHandler(upBtnId[row],topic.updown.click, row=row,up=TRUE, semid=semid)
    buttonHandler(downBtnId[row],topic.updown.click, row=row,up=FALSE, semid=semid)
    buttonHandler(addBtnId[row],add.topic.click, row=row, semid=semid)
    buttonHandler(removeBtnId[row],remove.topic.click, row=row, semid=semid)
  }
}


topic.updown.click = function(app=getApp(),value,row,up=TRUE,semid, se=app$se,...) {
  sel.df = se$seltopics[[as.character(semid)]]

  restore.point("topic.updown.click")

  new.pos = row + 1.5 - 3*up
  sel.df$topic_pos[row] = new.pos
  sel.df = sel.df[order(sel.df$topic_pos),]
  new.row = which(sel.df$topic_pos==new.pos)
  sel.df$topic_pos = rank(sel.df$topic_pos)
  se$seltopics[[as.character(semid)]] = sel.df

  show.sel.topics.table(semid=semid,sel.row = new.row)

}

add.topic.click = function(row, semid, app=getApp(),se=app$se,...) {
  restore.point("add.topic.click")

  sel.df = se$seltopics[[as.character(semid)]]
  all.df = se$semtopics[[as.character(semid)]]


  sel.df = bind_rows(sel.df,all.df[row,])
  sel.df$topic_pos = 1:NROW(sel.df)

  se$seltopics[[as.character(semid)]] = sel.df
  show.sel.topics.table(semid=semid, sel.row=NROW(sel.df))
  show.all.topics.table(semid=semid)

}

remove.topic.click = function(row,semid,app=getApp(),se=app$se,...) {
  restore.point("remove.topic.click")
  #cat("\nremove topic click")

  sel.df = se$seltopics[[as.character(semid)]]
  all.df = se$semtopics[[as.character(semid)]]

  topic_pos = sel.df$topic_pos[row]
  if (row < NROW(sel.df)) {
    rows = (row+1):NROW(sel.df)
    sel.df$topic_pos[rows] = sel.df$topic_pos[rows]-1
  }
  sel.df = sel.df[-row,]
  se$seltopics[[as.character(semid)]] = sel.df

  show.sel.topics.table(semid=semid)
  show.all.topics.table(semid=semid)
  write.stud.log("remove_topic", list(semid=semid))

}


show.stud.help.ui = function(se=app$se, app=getApp()) {
  restore.point("show.stud.help.ui")
  cr = app$glob$rmd.li[["studsem_help"]]
  envir = as.environment(se$admin)
  parent.env(envir) = baseenv()
  content = render.compiled.rmd(cr, envir=envir)
  setUI("studhelpUI",content)
}

stud.seminar.link.click = function(value, table, ..., app=getApp()) {
  args = list(...)
  se = app[["se"]]
  restore.point("stud.seminar.link.click")
  row = value

  try({
    if (table == "allSem") {
      semid = se$sem.df$semid[row]
      write.stud.log("open_link", list(semid=semid, table="all", row=row))
    } else if (table == "selSem") {
      semid = se$sel.df$semid[row]
      write.stud.log("open_link", list(semid=semid, table="sel", row=row))
    }
  })

}

write.stud.log = function(action, x=NULL, app=getApp()) {
  se = app[["se"]]
  file = app$glob$stud.log.file
  json = toJSON(c(list(action=action, time=Sys.time(), userid=se$stud$userid,semester=se$semester, round=se$round),x))
  try({
    con = file(file,"at")
    writeLines(json,con)
    close(con)
  })
}