[RQt-devel] Question about subclassing QAbstractTableModel

[John Verzani]

Hi, I'm trying to write an alternative to qdataFrameModel that has the same
speed, but has a more standard treatment of roles. I have the following. Two
questions though:

1) The items get drawn with a checkbox next to them. I make sure the flags()
method avoids Qt$Qt$ItemIsUserCheckable, but it is still there. Any idea
what I'm doing wrong/missing?

2) In the data() method, the Qt docs say I should return an invalid QVariant
instead of 0. I return NA. Is that right? I also wonder why I can't just
call super to get the default data for the role from the parent.

Thanks for any help, --John


library(qtbase)

n <- 10 ## or even 1e6
Df <- data.frame(a=1:n, b= rnorm(n))

qsetClass("DfModel", Qt$QAbstractTableModel, function(parent=NULL) {
  super(parent)
  this$dataframename <- "Df"  ## generalize after testing
})

qsetMethod("Df", DfModel, function() {
  get(this$dataframename, envir=.GlobalEnv)
})

qsetMethod("rowCount", DfModel, function(index) nrow(this$Df()))
qsetMethod("columnCount", DfModel, function(index) ncol(this$Df()))

qsetMethod("data", DfModel, function(index, role) {
  d <- this$Df()
  if(index$isValid()) {
    if(role == Qt$Qt$DisplayRole)
      out <- as.character(d[index$row() + 1, index$column() + 1])
    else if(role == Qt$Qt$EditRole)
      out <- as.character(d[index$row() + 1, index$column() + 1])
    else
      out <- NA
    ##    super("data", index, role) ## why does this fail?
  }
  return(out)
})

## coerce value to fit into x
fitIn <- function(x, value) UseMethod("fitIn")
fitIn.default <- function(x, value) value
fitIn.numeric <- function(x, value) as.numeric(value)
fitIn.integer <- function(x, value) as.integer(value)

qsetMethod("setData", DfModel, function(index, value, role) {

  if(index$isValid() && role == Qt$Qt$EditRole) {
    d <- this$Df()
    x <- d[, index$column() + 1]
    d[index$row() + 1, index$column() + 1] <- fitIn(x,value)

    assign(this$dataframename, d, envir=.GlobalEnv)

    dataChanged(index, index)
    return(TRUE)
  } else {
    return(FALSE)
  }
})

qsetMethod("flags", DfModel, function(index) {
  if(!index$isValid()) {
    return(Qt$Qt$ItemIsEnabled)
  } else {
    curFlags <- super("flags", index)
    if(curFlags & Qt$Qt$ItemIsUserCheckable)
      curFlags <- curFlags - Qt$Qt$ItemIsUserCheckable # try to remove
checkable
    return(curFlags | Qt$Qt$ItemIsEditable)
  }
})

## test it
model <- DfModel()

view <- Qt$QTableView()
view$setModel(model)

view$setEditTriggers(Qt$QAbstractItemView$AllEditTriggers)

view$show()
view$raise()
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.r-forge.r-project.org/pipermail/qtinterfaces-devel/attachments/20100829/6feadbe4/attachment.htm>