src/TeXmacs/progs/math/format-math-menu.scm

   1
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; MODULE      : format-math-menu.scm
   5 ;; DESCRIPTION : menus for altering text properties in math mode
   6 ;; COPYRIGHT   : (C) 1999  Joris van der Hoeven
   7 ;;
   8 ;; This software falls under the GNU general public license version 3 or later.
   9 ;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
  10 ;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
  11 ;;
  12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13
  14 (texmacs-module (math format-math-menu)
  15   (:use (generic format-edit)))
  16
  17 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18 ;; What kind of math font are we using?
  19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20
  21 (tm-define (real-math-font? fn)
  22   (or (== fn "roman") (== fn "concrete")))
  23
  24 (tm-define (real-math-family? fn)
  25   (or (== fn "mr") (== fn "ms") (== fn "mt")))
  26
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;; The Font menu in math mode
  29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30
  31 (menu-bind math-font-menu
  32   (-> "Name"
  33       ("Roman" (make-with "math-font" "roman"))
  34       (if (url-exists-in-tex? "ccr10.mf")
  35           ("Concrete" (make-with "math-font" "concrete")))
  36       (if (url-exists-in-tex? "eurm10.mf")
  37           ("New Roman" (make-with "math-font" "ENR")))
  38       ---
  39       (if (url-exists-in-tex? "rpsyr.tfm")
  40           ("Adobe" (make-with "math-font" "adobe")))
  41       (if (url-exists-in-tex? "cdr10.mf")
  42           ("Duerer" (make-with "math-font" "Duerer")))
  43       (if (url-exists-in-tex? "eufm10.mf")
  44           ("Euler" (make-with "math-font" "Euler")))
  45       (-> "Calligraphic"
  46           ("Default" (make-with "math-font" "cal"))
  47           (if (url-exists-in-tex? "euxm10.mf")
  48               ("Euler" (make-with "math-font" "cal**")))
  49           (if (url-exists-in-tex? "rsfs10.mf")
  50               ("Ralph Smith's" (make-with "math-font" "cal*"))))
  51       (-> "Blackboard bold"
  52           ("Default" (make-with "math-font" "Bbb*"))
  53           (if (url-exists-in-tex? "msbm10.mf")
  54               ("A.M.S." (make-with "math-font" "Bbb")))
  55           (if (url-exists-in-tex? "bbold10.mf")
  56               ("Blackboard bold" (make-with "math-font" "Bbb**")))
  57           (if (url-exists-in-tex? "ocmr10.mf")
  58               ("Outlined roman" (make-with "math-font" "Bbb***")))
  59           (if (url-exists-in-tex? "dsrom10.mf")
  60               ("Double stroke" (make-with "math-font" "Bbb****")))))
  61   (if (real-math-font? (get-env "math-font"))
  62       (-> "Variant"
  63           ("Roman" (make-with "math-font-family" "mr"))
  64           ("Typewriter" (make-with "math-font-family" "mt"))
  65           ("Sans serif" (make-with "math-font-family" "ms"))
  66           ---
  67           (-> "Text font"
  68               ("Roman" (make-with "math-font-family" "trm"))
  69               ("Typewriter" (make-with "math-font-family" "ttt"))
  70               ("Sans serif" (make-with "math-font-family" "tss"))
  71               ("Bold" (make-with "math-font-family" "bf"))
  72               ("Right" (make-with "math-font-family" "up"))
  73               ("Slanted" (make-with "math-font-family" "sl"))
  74               ("Italic" (make-with "math-font-family" "it"))))
  75       (if (real-math-family? (get-env "math-font-family"))
  76           (-> "Series"
  77               ("Light" (make-with "math-font-series" "light"))
  78               ("Medium" (make-with "math-font-series" "medium"))
  79               ("Bold" (make-with "math-font-series" "bold")))))
  80   (if (not (real-math-font? (get-env "math-font")))
  81       (-> "Variant"
  82           ("Roman" (make-with "math-font-family" "mr"))
  83           ("Typewriter" (make-with "math-font-family" "mt"))
  84           ("Sans serif" (make-with "math-font-family" "ms")))
  85       (-> "Series"
  86           ("Medium" (make-with "math-font-series" "medium"))
  87           ("Bold" (make-with "math-font-series" "bold")))
  88       (-> "Shape"
  89           ("Default" (make-with "math-font-shape" "normal"))
  90           ("Right" (make-with "math-font-shape" "right"))
  91           ("Slanted" (make-with "math-font-shape" "slanted"))
  92           ("Italic" (make-with "math-font-shape" "italic"))))
  93   (-> "Size" (link font-size-menu)))
  94
  95 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  96 ;; Special mathematical text properties
  97 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  98
  99 (menu-bind math-special-format-menu
 100   (-> "Index level"
 101       ("Normal" (make-with "math-level" "0"))
 102       ("Script size" (make-with "math-level" "1"))
 103       ("Script script size" (make-with "math-level" "2")))
 104   (-> "Display style"
 105       ("On" (make-with "math-display" "true"))
 106       ("Off" (make-with "math-display" "false")))
 107   (-> "Condensed"
 108       ("On" (make-with "math-condensed" "true"))
 109       ("Off" (make-with "math-condensed" "false"))))
 110
 111 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 112 ;; The main Format menu
 113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 114
 115 (menu-bind math-format-menu
 116   (group "Font")
 117   (link math-font-menu)
 118   (if (simple-menus?)
 119       (-> "Color" (link color-menu)))
 120   ---
 121   (group "Content")
 122   (if (detailed-menus?)
 123       (-> "Color" (link color-menu))
 124       (-> "Scripts" (link local-supported-scripts-menu)))
 125   (link math-special-format-menu))
 126
 127 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 128 ;; Icons for modifying mathematical text properties
 129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 130
 131 (menu-bind math-format-icons
 132   (=> (balloon (icon "tm_greek.xpm") "Insert a greek character")
 133       (tile 8 (link lower-greek-menu))
 134       ---
 135       (tile 8 (link upper-greek-menu)))
 136   (=> (balloon (icon "tm_mathbold.xpm")
 137                "Insert a bold character")
 138       (tile 15 (link bold-num-menu))
 139       ---
 140       (tile 13 (link bold-alpha-menu))
 141       ---
 142       (tile 15 (link bold-greek-menu))
 143       ---
 144       ("use a bold font" (make-with "math-font-series" "bold")))
 145   (=> (balloon (icon "tm_cal.xpm")
 146                "Insert a calligraphic character")
 147       (tile 13 (link cal-menu))
 148       ---
 149       ("use a calligraphic font" (make-with "math-font" "cal")))
 150   (=> (balloon (icon "tm_frak.xpm")
 151                "Insert a fraktur character")
 152       (tile 13 (link frak-menu))
 153       ---
 154       ("use the fraktur font" (make-with "math-font" "Euler")))
 155   (=> (balloon (icon "tm_bbb.xpm")
 156                "Insert a blackboard bold character")
 157       (tile 13 (link bbb-menu))
 158       ---
 159       ("use the blackboard bold font" (make-with "math-font" "Bbb*")))
 160   (if (not (in-graphics?))
 161       (=> (balloon (icon "tm_color.xpm") "Select a foreground color")
 162           (link color-menu))))