final version for ape 2.6-1

[ape.git] / R / makeLabel.R

diff --git a/R/makeLabel.R b/R/makeLabel.R
index 9d38dc1d2261f8579c7e7aa896bfa510ad4eb5f9..0ac2e44a820dfeab3d2a74463a82e7392c5329ff 100644 (file)
--- a/R/makeLabel.R
+++ b/R/makeLabel.R
@@ -1,8 +1,8 @@
-## makeLabel.R (2008-07-03)
+## makeLabel.R (2010-05-27)
 
 ##   Label Management
 
-## Copyright 2008 Emmanuel Paradis
+## Copyright 2010 Emmanuel Paradis
 
 ## This file is part of the R-package `ape'.
 ## See the file ../COPYING for licensing issues.
@@ -52,12 +52,12 @@ makeLabel.phylo <- function(x, tips = TRUE, nodes = TRUE, ...)
 
 makeLabel.multiPhylo <- function(x, tips = TRUE, nodes = TRUE, ...)
 {
-    y <- attr("TipLabel", x)
+    y <- attr(x, "TipLabel")
     if (is.null(y)) {
         for (i in 1:length(x))
             x[[i]] <- makeLabel.phylo(x[[i]], tips = tips, nodes = nodes, ...)
     } else {
-        attr("TipLabel", x) <- makeLabel.character(y, ...)
+        attr(x, "TipLabel") <- makeLabel.character(y, ...)
     }
     x
 }
@@ -69,3 +69,41 @@ makeLabel.DNAbin <- function(x, ...)
     else rownames(x) <- makeLabel.character(rownames(x), ...)
     x
 }
+
+mixedFontLabel <-
+    function(..., sep = " ", italic = NULL, bold = NULL, parenthesis = NULL,
+             always.upright = c("sp.", "spp.", "ssp."))
+{
+    x <- list(...)
+    n <- length(x)
+    sep <- rep(sep, length.out = n - 1L)
+
+    if (!is.null(italic)) {
+        for (i in italic) {
+            y <- x[[i]]
+            s <- ! y %in% always.upright
+            y[s] <- paste("italic('", y[s], "')", sep = "")
+            x[[i]] <- y
+        }
+    }
+
+    if (!is.null(bold)) {
+        for (i in bold) {
+            y <- x[[i]]
+            s <- logical(length(y))
+            s[grep("^italic", y)] <- TRUE
+            y[s] <- sub("^italic", "bolditalic", y[s])
+            y[!s] <- paste("bold('", y[!s], "')", sep = "")
+            x[[i]] <- y
+        }
+    }
+
+    if (!is.null(parenthesis))
+        for (i in parenthesis)
+            x[[i]] <- paste("(", x[[i]], ")", sep = "")
+
+    res <- x[[1L]]
+    for (i in 2:n)
+        res <- paste(res, "*'", sep[i - 1L], "'*", x[[i]], sep = "")
+    parse(text = res)
+}