Browse code

fixed grid.grabExpr won't return to current device

Zuguang Gu authored on 27/01/2021 20:10:19
Showing5 changed files

... ...
@@ -1,8 +1,8 @@
1 1
 Package: ComplexHeatmap
2 2
 Type: Package
3 3
 Title: Make Complex Heatmaps
4
-Version: 2.7.6.1003
5
-Date: 2021-1-26
4
+Version: 2.7.6.1004
5
+Date: 2021-1-27
6 6
 Author: Zuguang Gu
7 7
 Maintainer: Zuguang Gu <z.gu@dkfz.de>
8 8
 Depends: R (>= 3.1.2), methods, grid, graphics, stats, grDevices
... ...
@@ -5,6 +5,9 @@
5 5
 # == param
6 6
 # -which Whether it is a column annotation or a row annotation?
7 7
 # -border Whether draw borders of the annotation region?
8
+# -zoom If it is true and when the heatmap is split, the empty annotation slices will have	
9
+#       equal height or width, and you can see the correspondance between the annotation slices	
10
+#       and the original heatmap slices.
8 11
 # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation.
9 12
 # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation.
10 13
 #
... ...
@@ -42,7 +45,7 @@
42 45
 # draw(anno, test = "anno_empty")
43 46
 # anno = anno_empty(border = FALSE)
44 47
 # draw(anno, test = "anno_empty without border")
45
-anno_empty = function(which = c("column", "row"), border = TRUE,
48
+anno_empty = function(which = c("column", "row"), border = TRUE, zoom = FALSE,
46 49
 	width = NULL, height = NULL) {
47 50
 	
48 51
 	if(is.null(.ENV$current_annotation_which)) {
... ...
@@ -63,7 +66,7 @@ anno_empty = function(which = c("column", "row"), border = TRUE,
63 66
 		n = NA,
64 67
 		fun_name = "anno_empty",
65 68
 		which = which,
66
-		var_import = list(border),
69
+		var_import = list(border, zoom),
67 70
 		subset_rule = list(),
68 71
 		subsetable = TRUE,
69 72
 		height = anno_size$height,
... ...
@@ -541,7 +541,13 @@ discrete_legend_body = function(at, labels = at, nrow = NULL, ncol = 1, by_row =
541 541
 			fl = graphics[index]
542 542
 			gb_lt = list()
543 543
 			for(k in seq_along(fl)) {
544
-				gb_lt[[k]] = grid.grabExpr(fl[[k]](x = grid_x[1] + grid_width[i]*0.5, y = grid_y[k], w = grid_width[i], h = row_height_no_gap[k]), width = grid_width[i], height = row_height_no_gap[k])
544
+				gb_lt[[k]] = grid.grabExpr({
545
+						fl[[k]](x = grid_x[1] + grid_width[i]*0.5, y = grid_y[k], w = grid_width[i], h = row_height_no_gap[k])
546
+					}, 
547
+					width = convertWidth(grid_width[i], "inch", valueOnly = TRUE), 
548
+					height = convertHeight(row_height_no_gap[k], "inch", valueOnly = TRUE)
549
+				)
550
+					
545 551
 			}
546 552
 			gl = c(gl, gb_lt)
547 553
 		}
... ...
@@ -38,3 +38,23 @@ if(getRversion() >= "4.0.0" && as.numeric(rv$`svn rev`) >= 77889) {
38 38
 	unitType = function(x, recurse = TRUE) attr(x, "unit")
39 39
 }
40 40
 
41
+
42
+
43
+# from grid 4.0
44
+# the problem is with grid < 4.0, after executing `grid.grabExpr()`,
45
+# the current device changes. 
46
+if(getRversion() < "4.0.0") {
47
+  grid.grabExpr = function (expr, warn = 2, wrap = FALSE,  
48
+      width = 7, height = 7, device = grid:::offscreen, ...) {
49
+      cd <- dev.cur()
50
+      device(width, height)
51
+      grabd <- dev.cur()
52
+      on.exit({
53
+          dev.set(grabd)
54
+          dev.off()
55
+          dev.set(cd)
56
+      })
57
+      eval(expr)
58
+      grid:::grabDL(warn, wrap, ...)
59
+  }
60
+}
41 61
\ No newline at end of file
... ...
@@ -7,13 +7,14 @@ Empty Annotation
7 7
 Empty Annotation
8 8
 }
9 9
 \usage{
10
-anno_empty(which = c("column", "row"), border = TRUE,
10
+anno_empty(which = c("column", "row"), border = TRUE, zoom = FALSE,
11 11
     width = NULL, height = NULL)
12 12
 }
13 13
 \arguments{
14 14
 
15 15
   \item{which}{Whether it is a column annotation or a row annotation?}
16 16
   \item{border}{Whether draw borders of the annotation region?}
17
+  \item{zoom}{If it is true and when the heatmap is split, the empty annotation slices will have	 equal height or width, and you can see the correspondance between the annotation slices	 and the original heatmap slices.}
17 18
   \item{width}{Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation.}
18 19
   \item{height}{Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation.}
19 20