cgit.sxemacs.org Git - packages/blob - xemacs-packages/auctex/style/pstricks.el

   1 ;;; pstricks.el --- AUCTeX style for the `pstricks' package.
   2
   3 ;; Copyright (C) 2007, 2009, 2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Holger Sparr <holger.sparr@gmx.net>
   6 ;; Maintainer: auctex-devel@gnu.org
   7 ;; Created: 2007-06-14
   8 ;; Keywords: tex
   9
  10 ;; This file is part of AUCTeX.
  11
  12 ;; AUCTeX is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 3, or (at your option)
  15 ;; any later version.
  16
  17 ;; AUCTeX is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with AUCTeX; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
  25 ;; 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;; AUCTeX style file for PSTricks
  30 ;;
  31 ;; Support for basic PSTricks macros and their arguments. Separate
  32 ;; history variables for point, angle, ... arguments.
  33 ;;
  34 ;; Parameter input completion together with input completion for certain
  35 ;; parameters (e.g. linestyle, linecolor and the like).
  36 ;;
  37 ;; There is a PSTricks-specific support for adding new parameters to
  38 ;; existing parameter lists or changing existing ones in optional
  39 ;; macro arguments.  You might want to make those available through
  40 ;; key bindings by using something like
  41 ;; (define-key LaTeX-mode-map (kbd "C-c p a")
  42 ;;   'LaTeX-pst-parameter-add)
  43 ;; (define-key LaTeX-mode-map (kbd "C-c p c")
  44 ;;   'LaTeX-pst-parameter-change-value)
  45 ;; in a personal style file for PSTricks.
  46
  47 ;;; History:
  48 ;;
  49 ;; 14/06/2007 rewrite of pstricks.el based on Jean-Philippe Georget's
  50 ;;            pstricks.el version found on <URI:
  51 ;;            http://www.emacswiki.org/cgi-bin/wiki/pstricks.el>
  52
  53 ;;; TODO:
  54 ;;
  55 ;; -- Use alist or hash-table for parameter input
  56 ;; -- Add more regularly used PSTricks macros
  57 ;; -- Prevent errors in AUCTeX modes other than LaTeX mode.
  58 ;; -- Check if the functionality for adding and changing parameters
  59 ;;    can be generalized.
  60
  61 ;;; Code:
  62
  63 ;;; General Functions
  64
  65 (defun TeX-arg-compl-list (list &optional prompt hist)
  66   "Input a value after PROMPT with completion from LIST and HISTORY."
  67   (let ((first (car list)))
  68     (if (and first (listp first))
  69         (let ((func (nth 0 first))
  70               (prompt (concat (or (nth 1 first) prompt) ": "))
  71               (compl (nth 2 first))
  72               (hist (or (nth 3 first) hist))
  73               (crm-separator (nth 4 first))
  74               res)
  75           (setq list (cdr list))
  76           (cond ((eq func 'completing-read-multiple)
  77                  (setq res (funcall func prompt list nil compl nil hist))
  78                  (mapconcat 'identity res crm-separator))
  79                 ((eq func 'completing-read)
  80                  (setq res
  81                        (funcall func prompt list nil compl nil hist)))))
  82       (completing-read (concat prompt ": ") list nil nil nil hist))))
  83
  84 ;; XXX: Show default value in prompt.  Perhaps extend
  85 ;; `TeX-argument-prompt' to do that.
  86 (defun LaTeX-pst-what (what prompt default &optional arg)
  87   "Ask for WHAT with PROMPT with DEFAULT.
  88 The corresponding lists LaTeX-pst-<what>-\\(list\\|history\\)
  89 have to exist.
  90
  91 \(Used to define functions named LaTeX-pst-<what>.\))"
  92   (let ((list (intern (concat "LaTeX-pst-" what "-list")))
  93         (hist (intern (concat "LaTeX-pst-" what "-history"))))
  94     (if (not arg)
  95         (setq arg (TeX-arg-compl-list (symbol-value list) prompt hist)))
  96     (if (string= arg "")
  97         default
  98       (add-to-list list arg)
  99       arg)))
 100
 101 (defun LaTeX-pst-input-int (prompt arg)
 102   "Return number as string asked for with PROMPT if no number
 103 passed with ARG."
 104   (unless (numberp arg)
 105     (setq arg (read-number (concat prompt ": ") 2)))
 106   (number-to-string arg))
 107
 108 (defun LaTeX-pst-enclose-obj (symbol op cl)
 109   "Enclose string returned by the `funcall' SYMBOL in OP and CL
 110 character."
 111   (let ((str (funcall symbol)))
 112     (if str (insert (char-to-string op) str (char-to-string cl)))))
 113
 114 (defun LaTeX-package-parameter-value (param pname)
 115   "Ask for possible value of parameter PARAM given as string
 116 available through package name PNAME and return \"param=value\"."
 117   (add-to-list (intern (concat "LaTeX-" pname "-parameters-name-list"))
 118                param)
 119   ;; select predefined set
 120   (let* ((cregexp
 121           (symbol-value
 122            (intern (concat "LaTeX-" pname
 123                            "-parameters-completion-regexp"))))
 124          (bregexp
 125           (symbol-value (intern (concat "LaTeX-" pname
 126                                         "-parameters-boolean-regexp"))))
 127          (parlist (cond
 128                    ((string-match cregexp param)
 129                     (intern (concat "LaTeX-" pname "-"
 130                                     (match-string 0 param) "-list")))
 131                    ((string-match bregexp param)
 132                     'LaTeX-pst-boolean-list)))
 133          val compl)
 134     ;; ask for value
 135     (setq val (TeX-arg-compl-list
 136                (symbol-value parlist)
 137                (concat "(Press TAB for completions) " param)
 138                (intern (concat "LaTeX-" pname
 139                                "-parameters-value-history"))))
 140     ;; FIXME: This looks broken.  `compl' is never set and unless ""
 141     ;; is added to parlist (at least in the Boolean case), the prompt
 142     ;; shown by `TeX-arg-compl-list' will be incorrect.
 143     (if (and (not compl) parlist) (add-to-list parlist val))
 144     (if (string= val "") "" (concat param "=" val))))
 145
 146 (defun LaTeX-package-parameters-pref-and-chosen (param pname noskip)
 147   "Set values for elements of PARAM from package PNAME and
 148 further explicitly typed in parameters and return a comma
 149 separated list as string."
 150   (let ((allpars "")
 151         (fask (intern (concat "LaTeX-" pname "-parameter-value")))
 152         tpara parval)
 153     (when param
 154       (while param
 155         (setq tpara (pop param))
 156         (setq parval (funcall fask tpara))
 157         (setq allpars
 158               (concat allpars
 159                       (if (or (string= "" allpars) (string= "" parval))
 160                           "" ",") parval))))
 161     ;; ask for parameter names as long as none is given
 162     (when noskip
 163       (while
 164           (not
 165            (string=
 166             ""
 167             (setq tpara
 168                   (completing-read
 169                    "Parameter name (RET to stop): "
 170                    (symbol-value (intern
 171                                   (concat "LaTeX-" pname
 172                                           "-parameters-name-list")))
 173                    nil nil nil (intern
 174                                 (concat "LaTeX-" pname
 175                                         "-parameters-name-history"))))))
 176         (setq parval (funcall fask tpara))
 177         ;; concat param=value with other ones
 178         (setq allpars
 179               (concat allpars
 180                       (if (or (string= "" allpars) (string= "" parval))
 181                           ""
 182                         ",")
 183                       parval))))
 184     (add-to-list
 185      (intern (concat "LaTeX-" pname "-parameters-history")) allpars)
 186     allpars))
 187
 188 (defun LaTeX-package-parameters (optional pname preparam param)
 189   "Ask for parameters and manage several parameter lists for
 190 package PNAME"
 191   (let ((fask (intern
 192                (concat "LaTeX-" pname "-parameters-pref-and-chosen")))
 193         (hlist (intern (concat "LaTeX-" pname "-parameters-history")))
 194         (nlist
 195          (symbol-value
 196           (intern (concat "LaTeX-" pname "-parameters-name-list")))))
 197     ;;
 198     (when (and preparam (listp preparam))
 199       (setq preparam (funcall fask preparam)))
 200     ;;
 201     (setq param
 202           (TeX-completing-read-multiple
 203            (concat
 204             "Params (use <Up,Down> for history or RET for choices): ")
 205            nlist nil nil nil hlist))
 206     ;;
 207     (if (not param)
 208         (setq param (funcall fask nil t))
 209       (setq param (car (symbol-value hlist))))
 210     (TeX-argument-insert
 211      (if (or (string= "" preparam) (eq preparam nil))
 212          param
 213        (concat preparam (if (string= "" param) "" (concat "," param))))
 214      optional)))
 215
 216 ;;; Points
 217 (defvar LaTeX-pst-point-list (list "0,0")
 218   "A list of values for point in pstricks.")
 219
 220 (defvar LaTeX-pst-point-history LaTeX-pst-point-list
 221   "History of values for point in pstricks.")
 222
 223 (defun LaTeX-pst-point ()
 224   "Ask for a point and manage point list."
 225   (LaTeX-pst-what "point"
 226                   (concat "Point (default " (car LaTeX-pst-point-history) ")")
 227                   (car LaTeX-pst-point-history)))
 228
 229 (defun LaTeX-pst-point-in-parens (optional)
 230   "Enclose point in parentheses."
 231   (LaTeX-pst-enclose-obj 'LaTeX-pst-point ?( ?)))
 232
 233 ;;; Angles
 234 (defvar LaTeX-pst-angle-list (list "0")
 235   "A list of values for angle in pstricks.")
 236
 237 (defvar LaTeX-pst-angle-history nil
 238   "History of values for angle in pstricks.")
 239
 240 (defun LaTeX-pst-angle ()
 241   "Ask for a angle and manage angle list"
 242   (LaTeX-pst-what "angle"
 243                   (concat "Angle (default " (car LaTeX-pst-angle-list) ")")
 244                   (car LaTeX-pst-angle-list)))
 245
 246 ;;; Extension in one Direction
 247 (defvar LaTeX-pst-extdir-list (list "1")
 248   "A list of values for extdir in pstricks.")
 249
 250 (defvar LaTeX-pst-extdir-history nil
 251   "History of values for extdir in pstricks.")
 252
 253 (defun LaTeX-pst-extdir (descr)
 254   "Ask for a extdir and manage extdir list"
 255   (LaTeX-pst-what "extdir"
 256                   (concat descr " (default " (car LaTeX-pst-extdir-list) ")")
 257                   (car LaTeX-pst-extdir-list)))
 258
 259 ;;; Relative Points
 260 (defvar LaTeX-pst-delpoint-list nil
 261   "A list of values for delpoint in pstricks.")
 262
 263 (defvar LaTeX-pst-delpoint-history nil
 264   "History of values for delpoint in pstricks.")
 265
 266 ;;; Arrows
 267 (defvar LaTeX-pst-arrows-list
 268   '("->" "<-" "<->" ">-<" ">-" "-<" "<<->>" "<<-" "->>" "|-|" "|-" "-|"
 269   "|*-|*" "[-]" "[-" "-]" "(-)" "(-" "-)" "*-*" "*-" "-*" "0-0" "0-"
 270   "-0" "c-c" "c-" "-c" "C-C" "C-" "-C" "cc-cc" "cc-" "-cc" "|<->|" "|<-"
 271   "->|" "|<*->|*" "|<*-" "->|*" "-")
 272   "A list of values for arrows in pstricks.")
 273
 274 (defvar LaTeX-pst-arrows-history nil
 275   "History of values for arrows in pstricks.")
 276
 277 ;; XXX: Better ask for arrow start and end separately?
 278 ;; `LaTeX-pst-arrows-list' is not exhaustive.
 279 (defun LaTeX-pst-arrows ()
 280   "Ask for a arrow type and manage arrow type list"
 281   (or (LaTeX-pst-what "arrows" "Arrow type" nil) ""))
 282
 283 ;;; Dots
 284 (defvar LaTeX-pst-dotstyle-list
 285   '((completing-read "Dot style" nil LaTeX-pst-dotstyle-history)
 286     "*" "o" "+" "|" "triangle" "triangle*" "square" "square*" "pentagon"
 287     "pentagon*")
 288   "A list of values for dotstyle in pstricks.")
 289
 290 (defvar LaTeX-pst-dotstyle-history nil
 291   "History of values for dotstyle in pstricks.")
 292
 293 ;;; Reference Point
 294 (defvar LaTeX-pst-refpoint-list
 295   '((completing-read "Reference point" t LaTeX-pst-refpoint-history)
 296     "l" "r" "t" "tl" "lt" "tr" "rt" "b" "bl" "br" "lb" "rb" "B" "Bl"
 297     "Br" "lB" "rB")
 298   "A list of values for refpoint in pstricks.")
 299
 300 (defvar LaTeX-pst-refpoint-history nil
 301   "History of values for refpoint in pstricks.")
 302
 303 (defun LaTeX-pst-refpoint ()
 304   "Ask for a refpoint and manage refpoint list"
 305   (LaTeX-pst-what "refpoint" "Reference point" nil))
 306
 307 ;;; Color
 308
 309 ;; FIXME: Still used?
 310 (defvar LaTeX-pst-color-history nil
 311   "History of values for color in pstricks.")
 312
 313 ;;; Others without History in Completion
 314
 315 (defvar LaTeX-pst-style-list
 316   '((completing-read "Defined Style" t))
 317   "A list of values for user defined styles in pstricks.")
 318
 319 ;;; Parameters
 320
 321 (defvar LaTeX-pst-parameters-history nil
 322   "History of values for parameters in pstricks.")
 323
 324 (defvar LaTeX-pst-parameters-value-history nil
 325   "History of parameter values in pstricks.")
 326
 327 (defvar LaTeX-pst-basic-parameters-name-list
 328   '("arcsep" "arcsepA" "arcsepB" "arrowinset" "arrowlength" "arrows"
 329     "arrowscale" "arrowsize" "border" "bordercolor" "boxsep"
 330     "bracketlength" "cornersize" "curvature" "dash" "dimen" "dotangle"
 331     "dotscale" "dotsep" "dotsize" "dotstyle" "doublecolor" "doubleline"
 332     "doublesep" "doubleset" "fillcolor" "fillstyle" "framearc"
 333     "framesep" "gangle" "gridcolor" "griddots" "gridlabelcolor"
 334     "gridlabels" "gridwidth" "hatchangle" "hatchcolor" "hatchsep"
 335     "hatchsepinc" "hatchwidth" "hatchwidthinc" "header" "labelsep"
 336     "liftpen" "linearc" "linecolor" "linestyle" "linetype" "linewidth"
 337     "rbracketlength" "ref" "runit" "shadow" "shadowangle" "shadowcolor"
 338     "shadowsize" "showgrid" "showpoints" "style" "subgridcolor"
 339     "subgriddiv" "subgriddots" "subgridwidth" "swapaxes" "tbarsize"
 340     "trimode" "unit" "xunit" "yunit")
 341   "A list of parameter names in pstricks.")
 342
 343
 344 (defvar LaTeX-pst-boolean-list '("true" "false")
 345   "List of binary values for key=value completion.")
 346
 347 ;; XXX: Colors can actually be given as [-]<color>[!<num>].
 348 (defvar LaTeX-pst-color-list
 349   '("black" "darkgray" "gray" "lightgray" "white"
 350     "red" "green" "blue" "cyan" "magenta" "yellow")
 351   "List of colors predefined in PSTricks.")
 352
 353 (defvar LaTeX-pst-fillstyle-list
 354   '("none" "solid" "vlines" "vlines*" "hlines" "hlines*" "crosshatch"
 355     "crosshatch*" "boxfill")
 356   "List of fill styles defined in PSTricks.")
 357
 358 ;; From PSTricks: PostScript macros for Generic TeX, User's Guide,
 359 ;; Timothy Van Zandt, 25 July 2003, Version 97.
 360 ;; FIXME: Provide separate variables tailored to the different macros.
 361 (defvar LaTeX-pst-basic-parameters-list
 362   '(;; Dimensions, coordinates and angles
 363     ("unit")
 364     ("xunit")
 365     ("yunit")
 366     ("runit")
 367     ;; Basic graphics parameters
 368     ("linewidth")
 369     ("linecolor" LaTeX-pst-color-list)
 370     ("fillstyle" LaTeX-pst-fillstyle-list)
 371     ("fillcolor" LaTeX-pst-color-list)
 372     ("arrows" LaTeX-pst-arrows-list)
 373     ("showpoints" LaTeX-pst-boolean-list)
 374     ;; Lines and polygons
 375     ("linearc")
 376     ("framearc")
 377     ("cornersize" ("relative" "absolute"))
 378     ("gangle")
 379     ;; Arcs, circles and ellipses
 380     ("arcsepA")
 381     ("arcsepB")
 382     ("arcsep")
 383     ;; Curves
 384     ("curvature")
 385     ;; Dots
 386     ("dotstyle" ("*" "o" "Bo" "x" "+" "B+" "asterisk" "Basterisk" "oplus"
 387                  "otimes" "|" "B|" "square" "Bsquare" "square*" "diamond"
 388                  "Bdiamond" "diamond*" "triangle" "Btriangle" "triangle*"
 389                  "pentagon" "Bpentagon" "pentagon*"))
 390     ("dotsize")
 391     ("dotscale")
 392     ("dotangle")
 393     ;; Grids
 394     ("gridwidth")
 395     ("gridcolor" LaTeX-pst-color-list)
 396     ("griddots")
 397     ("gridlabels")
 398     ("gridlabelcolor" LaTeX-pst-color-list)
 399     ("subgriddiv")
 400     ("subgridwidth")
 401     ("subgridcolor" LaTeX-pst-color-list)
 402     ("subgriddots")
 403     ;; Plots
 404     ("plotstyle" ("dots" "line" "polygon" "curve" "ecurve" "ccurve"))
 405     ("plotpoints")
 406     ;; Coordinate systems
 407     ("origin")
 408     ("swapaxes" LaTeX-pst-boolean-list)
 409     ;; Line styles
 410     ("linestyle" ("none" "solid" "dashed" "dotted"))
 411     ("dash")
 412     ("dotsep")
 413     ("border")
 414     ("bordercolor" LaTeX-pst-color-list)
 415     ("doubleline" LaTeX-pst-boolean-list)
 416     ("doublesep")
 417     ("doublecolor" LaTeX-pst-color-list)
 418     ("shadow" LaTeX-pst-boolean-list)
 419     ("shadowsize")
 420     ("shadowangle")
 421     ("shadowcolor" LaTeX-pst-color-list)
 422     ("dimen" ("outer" "inner" "middle"))
 423     ;; Fill styles
 424     ("hatchwidth")
 425     ("hatchsep")
 426     ("hatchcolor" LaTeX-pst-color-list)
 427     ("hatchangle")
 428     ("addfillstyle" LaTeX-pst-fillstyle-list)
 429     ;; Arrowheads and such
 430     ("arrowsize")
 431     ("arrowlength")
 432     ("arrowwinset")
 433     ("tbarsize")
 434     ("bracketlength")
 435     ("rbracketlength")
 436     ("arrowscale")
 437     ;; Parameters
 438     ("linetype")
 439     ;; Graphics objects
 440     ("liftpen")
 441     ;; Placing and rotating whatever
 442     ("labelsep")
 443     ;; Axes
 444     ("labels" ("all" "x" "y" "none"))
 445     ("showorigin" LaTeX-pst-boolean-list)
 446     ("ticks" ("all" "x" "y" "none"))
 447     ("tickstyle" ("full" "top" "bottom"))
 448     ("ticksize")
 449     ("axesstyle" ("axes" "frame" "none"))
 450     ;; Framed boxes
 451     ("framesep")
 452     ("boxsep")
 453     ("trimode" ("*" "U" "D" "R" "L"))
 454     ;; Nodes
 455     ("href")
 456     ("vref")
 457     ("radius")
 458     ;; Node connections
 459     ("nodesep")
 460     ("arcangle")
 461     ("angle")
 462     ("arm")
 463     ("loopsize")
 464     ("ncurv")
 465     ("boxsize")
 466     ("offset")
 467     ;; Node connections labels: I
 468     ("ref")
 469     ("nrot")
 470     ("npos")
 471     ("shortput" ("none" "nab" "tablr" "tab"))
 472     ;; Node connection labels: II
 473     ("tpos")
 474     ;; Attaching labels to nodes
 475     ("rot")
 476     ;; Mathematical diagrams and graphs
 477     ("mnode" ("R" "r" "C" "f" "p" "circle" "oval" "dia" "tri" "dot" "none"))
 478     ("emnode" ("R" "r" "C" "f" "p" "circle" "oval" "dia" "tri" "dot" "none"))
 479     ("name")
 480     ("nodealign" LaTeX-pst-boolean-list)
 481     ("mcol" ("l" "r" "c"))
 482     ("rowsep")
 483     ("colsep")
 484     ("mnodesize")
 485     ;; ...
 486     )
 487   "List of keys and values for PSTricks macro arguments.")
 488
 489 (defvar LaTeX-pst-parameters-name-list
 490   LaTeX-pst-basic-parameters-name-list
 491   "A list of all parameters with completion.")
 492
 493 (defvar LaTeX-pst-parameters-name-history nil
 494   "History of parameter names in pstricks.")
 495
 496 (defvar LaTeX-pst-parameters-completion-regexp
 497   "\\(arrows\\|linestyle\\|fillstyle\\|color\\|trimode\\|dotstyle\\|\\<style\\)"
 498   "Regexp for `string-match'ing a parameter.")
 499
 500 (defvar LaTeX-pst-parameters-boolean-regexp
 501   "\\(doubleline\\|shadow\\>\\|show[a-zA-Z]+\\)"
 502   "Regexp for `string-match'ing a parameter.")
 503
 504 (defun LaTeX-pst-parameter-value (param)
 505   "See documentation of `LaTeX-package-parameter-value'."
 506   (LaTeX-package-parameter-value param "pst"))
 507
 508 (defun LaTeX-pst-parameters-pref-and-chosen (param &optional noskip)
 509   "See documentation of `LaTeX-package-parameters-pref-and-chosen'."
 510   (LaTeX-package-parameters-pref-and-chosen param "pst" noskip))
 511
 512 ;; FIXME: This is likely only a transitional function used until all
 513 ;; macros got their calls to `TeX-arg-key-val' with tailored parameter
 514 ;; lists.
 515 (defun LaTeX-pst-parameters (optional)
 516   "Prompt for general parameters of a PSTricks argument."
 517   (TeX-arg-key-val optional LaTeX-pst-basic-parameters-list))
 518
 519 ;;; Macros
 520 (defun LaTeX-pst-macro-psarc (optional &optional arg)
 521   "Return \\psarc arguments after querying."
 522   (let ((arrows (LaTeX-pst-arrows))
 523         (pnt (if current-prefix-arg nil (LaTeX-pst-point))))
 524     (insert (if arrows (format "{%s}" arrows) "")
 525             (if pnt (format "(%s)" pnt) "")
 526             "{" (LaTeX-pst-extdir "Radius") "}{" (LaTeX-pst-angle) "}{"
 527             (LaTeX-pst-angle) "}")))
 528
 529 (defun LaTeX-pst-macro-pscircle (optional &optional arg)
 530   "Return \\pscircle arguments after querying."
 531   (insert "(" (LaTeX-pst-point) "){" (LaTeX-pst-extdir "Radius") "}"))
 532
 533 (defun LaTeX-pst-macro-rput (optional &optional arg)
 534   "Return \\rput arguments after querying."
 535   (let ((refpoint (LaTeX-pst-refpoint))
 536         (rotation (if current-prefix-arg (LaTeX-pst-angle) nil)))
 537     (insert (if refpoint (concat "[" refpoint "]") "")
 538             (if rotation
 539                 (concat "{" rotation "}")
 540               "") "(" (LaTeX-pst-point) ")")))
 541
 542 (defun LaTeX-pst-macro-uput (optional &optional arg)
 543   "Return \\uput arguments after querying."
 544   (let ((dist (LaTeX-pst-extdir "Distance"))
 545         (refpoint (LaTeX-pst-refpoint)))
 546     (insert (if dist (concat "{" dist "}") "")
 547             (if refpoint
 548                 (concat "[" (LaTeX-pst-refpoint) "]")
 549               "[]")
 550             "{" (LaTeX-pst-angle) "}(" (LaTeX-pst-point) ")")))
 551
 552 (defun LaTeX-pst-macro-multirputps (optional &optional arg)
 553   "Return \\multirput or \\multips arguments after querying."
 554   (let ((refpoint (LaTeX-pst-refpoint))
 555         (rotation (if current-prefix-arg (LaTeX-pst-angle) nil))
 556         (pnt (LaTeX-pst-point))
 557         (dpnt (LaTeX-pst-what "delpoint" "Increment (default 1,1)" "1,1"))
 558         (repi (LaTeX-pst-input-int "Repetitions" nil)))
 559     (insert (if refpoint (format "[%s]" refpoint) "")
 560             (if rotation (format "{%s}" rotation) "")
 561             "(" pnt ")(" dpnt "){" repi "}")))
 562
 563 (defun LaTeX-pst-macro-psline (optional &optional arg)
 564   "Return \\psline or \\ps[ce]?curve[*] arguments after querying."
 565   (let ((arrows (LaTeX-pst-arrows))
 566         (pnt1 (LaTeX-pst-point))
 567         (pnt2 (LaTeX-pst-point)))
 568     (insert (if arrows (format "{%s}" arrows) "") "(" pnt1 ")" )
 569     (while (and (not (string= pnt2 "")) (not (string= pnt1 pnt2)))
 570       (insert "(" pnt2 ")")
 571       (setq pnt1 pnt2)
 572       (setq pnt2 (LaTeX-pst-point)))))
 573
 574 (defun LaTeX-pst-macro-psdots (optional single)
 575   "Return \\psdot[s]? arguments after querying."
 576   (let* ((pnt1 (LaTeX-pst-point))
 577          (pnt2 (if single pnt1 (LaTeX-pst-point))))
 578     (insert "(" pnt1 ")")
 579     (while (and (not (string= pnt2 "")) (not (string= pnt1 pnt2)))
 580       (setq pnt1 pnt2)
 581       (insert "(" pnt1 ")")
 582       (setq pnt2 (LaTeX-pst-point)))))
 583
 584 (defun LaTeX-pst-macro-parabola (optional &optional arg)
 585   "Return \\parabola arguments after querying."
 586   (let ((arrows (LaTeX-pst-arrows)))
 587     (insert (if arrows (format "{%s}" arrows) "")
 588             "(" (LaTeX-pst-point) ")(" (LaTeX-pst-point) ")")))
 589
 590 (defun LaTeX-pst-macro-pnt-twolen (optional prompt1 prompt2)
 591   "Return point and 2 paired lengths in separate parens as arguments."
 592   ;; insert \psellipse[*]?, \psdiamond or \pstriangle  arguments
 593   (let ((pnt (if current-prefix-arg nil (LaTeX-pst-point))))
 594     (insert (if pnt (format "(%s)" pnt) "")
 595             "(" (LaTeX-pst-extdir prompt1) ","
 596             (LaTeX-pst-extdir prompt2) ")")))
 597
 598 (defun LaTeX-pst-macro-psbezier (optional &optional arg)
 599   "Return \\psbezier arguments after querying."
 600   (let ((arrows (LaTeX-pst-arrows))
 601         (pnt1 (LaTeX-pst-point))
 602         (pnt2 (LaTeX-pst-point))
 603         (pnt3 (LaTeX-pst-point)))
 604     (insert (if arrows (format "{%s}" arrows) "")
 605             "(" pnt1 ")(" pnt2 ")")
 606     (while (not (string= pnt2 pnt3))
 607       (insert "(" pnt3 ")")
 608       (setq pnt2 pnt3)
 609       (setq pnt3 (LaTeX-pst-point)))))
 610
 611 (defun LaTeX-pst-macro-pspolygon (optional &optional arg)
 612   "Return \\pspolygon arguments after querying."
 613   (let ((pnt1 (LaTeX-pst-point))
 614         (pnt2 (LaTeX-pst-point))
 615         (pnt3 (LaTeX-pst-point)))
 616     (insert "(" pnt1 ")(" pnt2 ")")
 617     (while (not (string= pnt2 pnt3))
 618       (insert "(" pnt3 ")")
 619       (setq pnt2 pnt3)
 620       (setq pnt3 (LaTeX-pst-point)))))
 621
 622 (defun LaTeX-pst-macro-psframe (optional &optional arg)
 623   "Return \\psframe arguments after querying."
 624   (let ((pnt1 (if current-prefix-arg nil (LaTeX-pst-point)))
 625         (pnt2 (LaTeX-pst-point)))
 626     (insert (if pnt1 (format "(%s)" pnt1) "") "(" pnt2 ")")))
 627
 628 (defun LaTeX-pst-macro-psgrid (optional &optional arg)
 629   "Return \\psgrid arguments after querying."
 630   (let* ((cpref (if current-prefix-arg (car current-prefix-arg) 0))
 631          (pnt1 (if (> cpref 4) (LaTeX-pst-point) nil))
 632          (pnt2 (if (> cpref 0) (LaTeX-pst-point) nil))
 633          (pnt3 (if (> cpref 0) (LaTeX-pst-point) nil)))
 634     (insert (if pnt1 (format "(%s)" pnt1) "")
 635             (if pnt2 (format "(%s)(%s)" pnt2 pnt3) ""))))
 636
 637 (defun LaTeX-pst-macro-newpsobject (&optional arg)
 638   "Return \\newpsobject arguments after querying."
 639   (insert "{" (read-string "New PSObject Name: ") "}"
 640           ;; FIXME: It would be better to use something more confined
 641           ;; than `TeX-symbol-list'.
 642           "{" (completing-read "Parent Object: " (TeX-symbol-list))
 643           "}"))
 644
 645 ;;; Environments
 646 (defun LaTeX-pst-env-pspicture (env)
 647   "Create new pspicure environment."
 648   (let ((opt (multi-prompt-key-value
 649               (TeX-argument-prompt t "Options" nil)
 650               '(("showgrid") ("shift"))))
 651         (p0 (LaTeX-pst-what "point" "Lower left (default 0,0)" "0,0"))
 652         (p1 (LaTeX-pst-what "point" "Upper right (default 1,1)" "1,1"))
 653         corn)
 654     (setq corn (concat (unless (string= "" opt) (format "[%s]" opt))
 655                        (if (string= "0,0" p0) "" (format "(%s)" p0))
 656                        "(" p1 ")"))
 657     (LaTeX-insert-environment env corn)))
 658
 659 ;;; Self Parsing --  see (info "(auctex)Hacking the Parser")
 660 (defvar LaTeX-auto-pstricks-regexp-list
 661   '(("\\\\newps\\(object\\){\\([a-zA-Z]+\\)}{\\([a-zA-Z]+\\)}" (1 2 3)
 662      LaTeX-auto-pstricks)
 663     ("\\\\newps\\(fontdot\\){\\([a-zA-Z]+\\)}" (1 2)
 664      LaTeX-auto-pstricks)
 665     ("\\\\newps\\(style\\){\\([a-zA-Z]+\\)}" (1 2)
 666      LaTeX-auto-pstricks)
 667     ("\\\\define\\(color\\){\\([a-zA-Z]+\\)}{\\(rgb\\|cmyk\\)}" (1 2 3)
 668      LaTeX-auto-pstricks)
 669     ("\\\\new\\(rgb\\|hsb\\|cmyk\\)\\(color\\){\\([a-zA-Z]+\\)}" (2 3 1)
 670      LaTeX-auto-pstricks))
 671   "List of regular expressions to extract arguments of \\newps* macros.")
 672
 673 (defvar LaTeX-auto-pstricks nil
 674   "Temporary for parsing \\newps* definitions.")
 675
 676 (defun LaTeX-pst-cleanup ()
 677   "Move symbols from `LaTeX-auto-pstricks' to `TeX-auto-symbol'."
 678   (mapcar
 679    (lambda (list)
 680      (let ((type (car list)))
 681        (cond ((string= type "object")
 682               (setq TeX-auto-symbol
 683                     (cons (list (nth 1 list)
 684                                 (caddr (assoc (nth 2 list)
 685                                               (TeX-symbol-list))))
 686                           TeX-auto-symbol)))
 687              ((string= type "fontdot")
 688               (add-to-list 'LaTeX-pst-dotstyle-list (nth 1 list) t))
 689              ((string= type "style")
 690               (add-to-list 'LaTeX-pst-style-list (nth 1 list) t))
 691              ((string= type "color")
 692               (add-to-list 'LaTeX-pst-color-list (nth 1 list) t)
 693               ;; FIXME: Why is an entry with "-" in front added?
 694               (add-to-list 'LaTeX-pst-color-list
 695                            (concat "-" (nth 1 list)) t)))))
 696    LaTeX-auto-pstricks))
 697
 698 (defun LaTeX-pst-prepare ()
 699   "Clear `LaTeX-auto-pstricks' before use."
 700   (setq LaTeX-auto-pstricks nil))
 701
 702 ;; FIXME: This does not seem to work unless one does a manual reparse.
 703 ;; Check e.g. with "\definecolor" and "fillcolor=".
 704 (add-hook 'TeX-auto-prepare-hook 'LaTeX-pst-prepare)
 705 (add-hook 'TeX-auto-cleanup-hook 'LaTeX-pst-cleanup)
 706
 707 ;;; Additional Functionality
 708 (defun LaTeX-pst-parameters-add (&optional arg)
 709   "With ARG as prefix-argument insert new parameter\(s\) behind
 710 nearest backward LaTeX macro in brackets. Without ARG add
 711 parameter\(s\) to the already existing ones at the end of the
 712 comma separated list. Point has to be within the sexp to modify."
 713   (interactive "P")
 714   (let ((newpara  (LaTeX-pst-parameters-pref-and-chosen nil t))
 715         (regexp "\\(") beg end check)
 716     (if arg
 717         (progn
 718           (re-search-backward "\\\\\\([a-zA-Z]\\)")
 719           (forward-word 1)
 720           (insert-pair nil ?[ ?]))
 721       (up-list 1)
 722       (backward-char 1)
 723       (save-excursion
 724         (setq end (point))
 725         (up-list -1)
 726         (while (re-search-forward "\\([a-zA-Z]+\\)=" end 'limit)
 727           (setq regexp (concat regexp
 728                                (match-string-no-properties 1) "\\|")))
 729         (setq regexp (concat (substring regexp 0 -1) ")"))
 730         (setq check (string-match regexp newpara))))
 731     (when newpara
 732       (insert (if arg "" ",") newpara)
 733       (when check
 734         (message
 735          "At least one Parameters appears twice. PLEASE CHECK!")))))
 736 ;; FIXME: Only define a key for this once it is a general-purpose
 737 ;; facility, i.e. not just for pstricks but all types of macros.
 738 ;; (define-key LaTeX-mode-map "\C-c\C-x\C-a" 'LaTeX-pst-parameters-add)
 739
 740 (defvar LaTeX-pst-value-regexp
 741   "\\([-!.a-zA-Z0-9]*\\s\\?[-!.a-zA-Z0-9]+\\)"
 742   "Expression matching a parameter value.")
 743
 744 (defun LaTeX-pst-parameter-remove-value ()
 745   "Remove value of current parameter and return parameter name."
 746   (re-search-backward
 747    (concat "\\(\\s(\\|,\\)[a-zA-Z]+\\([a-zA-Z]\\|=\\|="
 748            LaTeX-pst-value-regexp "\\)"))
 749   (re-search-forward "\\([a-zA-Z]+\\)=")
 750   (let ((para (match-string-no-properties 1)))
 751     (re-search-forward LaTeX-pst-value-regexp)
 752     (delete-region (match-beginning 1) (match-end 1))
 753     para))
 754
 755 (defun LaTeX-pst-parameter-change-value ()
 756   "Replace parameter value with a new one."
 757   (interactive)
 758   (let* ((para (LaTeX-pst-parameter-remove-value))
 759          (symb
 760           (when (and
 761                  (string-match
 762                   LaTeX-pst-parameters-completion-regexp para)
 763                  (boundp
 764                   (intern
 765                    (concat "LaTeX-pst-" (match-string 0 para) "-list"))))
 766             (intern (concat "LaTeX-pst-" (match-string 0 para)
 767                             "-list")))))
 768     (insert (TeX-arg-compl-list (symbol-value symb) "New Value"
 769                                 'LaTeX-pst-parameters-value-history))))
 770 ;; FIXME: Only define a key for this once it is a general-purpose
 771 ;; facility, i.e. not just for pstricks but all types of macros.  (See
 772 ;; also `LaTeX-pst-parameters-add'.  Note that a parameter change
 773 ;; should better be made available through a `C-u' prefix of the
 774 ;; binding for the function doing the parameter addition.)
 775 ;; (define-key LaTeX-mode-map "\C-c\C-x\C-v" 'LaTeX-pst-parameter-change-value)
 776
 777 (TeX-add-style-hook
 778  "pstricks"
 779  (lambda ()
 780    (unless (member "pst-pdf" TeX-active-styles)
 781      (TeX-PDF-mode-off))
 782    (mapc 'TeX-auto-add-regexp LaTeX-auto-pstricks-regexp-list)
 783    (LaTeX-add-environments
 784     '("pspicture" LaTeX-pst-env-pspicture)
 785     "overlaybox" "psclip")
 786    (TeX-add-symbols
 787     '("AltClipMode" 0) '("DontKillGlue" 0) '("KillGlue" 0)
 788     '("NormalCoor" 0) '("SpecialCoor" 0) '("PSTricksLoaded" 0)
 789     '("PSTricksOff" 0) '("altcolormode" 0) '("pslinecolor" 0)
 790     '("pslinestyle" 0) '("pslinetype" 0) '("pslinewidth" 0)
 791     '("pslabelsep" 0) '("radian" 0) '("psunit" 0) '("psrunit" 0)
 792     '("psxunit" 0) '("psyunit" 0)
 793     '("arrows" (TeX-arg-eval LaTeX-pst-arrows))
 794     '("clipbox" ["Border"] t)
 795     '("closedshadow" [LaTeX-pst-parameters])
 796     '("openshadow" [LaTeX-pst-parameters])
 797     "closepath" "code" "coor" "curveto" "degrees" "dim" "endpsclip"
 798     "file" "fill" "grestore" "gsave" "lineto" "movepath" "moveto"
 799     "mrestore" "msave" "newpath" "rcoor" "rcurveto" "rlineto" "rotate"
 800     "scale" "stroke" "swapaxes" "translate"
 801     '("newcmykcolor" "Name" "Quadruple")
 802     '("newrgbcolor" "Name" "Triple") '("newhsbcolor" "Name" "Triple")
 803     '("newgray" "Name" "Value")
 804     '("newpsobject" LaTeX-pst-macro-newpsobject LaTeX-pst-parameters)
 805     '("newpsstyle" "New PSStyle Name" LaTeX-pst-parameters)
 806     '("newpsfontdot" "New PSDot Name" ["Factors"]
 807       "Fontname" "Character Number (Hex)")
 808     '("parabola" [LaTeX-pst-parameters] LaTeX-pst-macro-parabola)
 809     '("parabola*" [LaTeX-pst-parameters] LaTeX-pst-macro-parabola)
 810     '("psarc" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
 811     '("psarc*" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
 812     '("psarcn" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
 813     '("pswedge" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
 814     '("psbezier" [LaTeX-pst-parameters] LaTeX-pst-macro-psbezier)
 815     '("psbezier*" [LaTeX-pst-parameters] LaTeX-pst-macro-psbezier)
 816     '("pscbezier" [LaTeX-pst-parameters] LaTeX-pst-macro-pspolygon)
 817     '("pscircle" [LaTeX-pst-parameters] LaTeX-pst-macro-pscircle)
 818     '("psccurve" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
 819     '("psccurve*" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
 820     '("pscurve" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
 821     '("pscurve*" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
 822     '("pscustom" [LaTeX-pst-parameters])
 823     '("psdiamond" [LaTeX-pst-parameters]
 824       (LaTeX-pst-macro-pnt-twolen "Width" "Height"))
 825     '("pstriangle" [LaTeX-pst-parameters]
 826       (LaTeX-pst-macro-pnt-twolen "Width" "Height"))
 827     '("psdot" [LaTeX-pst-parameters] (LaTeX-pst-macro-psdots t))
 828     '("psdots" [LaTeX-pst-parameters] (LaTeX-pst-macro-psdots nil))
 829     '("psecurve" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
 830     '("psecurve*" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
 831     '("psellipse" [LaTeX-pst-parameters]
 832       (LaTeX-pst-macro-pnt-twolen "Radius x" "Radius y"))
 833     '("psellipse*" [LaTeX-pst-parameters]
 834       (LaTeX-pst-macro-pnt-twolen "Radius x" "Radius y"))
 835     '("psframe" [LaTeX-pst-parameters] LaTeX-pst-macro-psframe)
 836     '("psframe*" [LaTeX-pst-parameters] LaTeX-pst-macro-psframe)
 837     '("psframebox" [LaTeX-pst-parameters] t)
 838     '("pscirclebox" [LaTeX-pst-parameters] t)
 839     '("psdblframebox" [LaTeX-pst-parameters] t)
 840     '("psdiabox" [LaTeX-pst-parameters] t)
 841     '("psovalbox" [LaTeX-pst-parameters] t)
 842     '("psshadowbox" [LaTeX-pst-parameters] t)
 843     '("pstribox" [LaTeX-pst-parameters] t)
 844     '("psscalebox" "Scaling Factor(s)" t)
 845     '("psscaleboxto" LaTeX-pst-point-in-parens t)
 846     '("psgrid" [LaTeX-pst-parameters] LaTeX-pst-macro-psgrid 0)
 847     '("psline" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
 848     '("psoverlay" t)
 849     '("pspolygon" [LaTeX-pst-parameters] LaTeX-pst-macro-pspolygon)
 850     '("pspolygon*" [LaTeX-pst-parameters] LaTeX-pst-macro-pspolygon)
 851     '("psset" LaTeX-pst-parameters)
 852     '("pssetlength" TeX-arg-macro "Length")
 853     '("psaddtolength" TeX-arg-macro "Length")
 854     '("degrees" ["Full Circle"])
 855     '("qdisk" LaTeX-pst-point-in-parens "Radius")
 856     '("qline" LaTeX-pst-point-in-parens LaTeX-pst-point-in-parens)
 857     "pslongbox" "psrotatedown" "psrotateleft" "psrotateright"
 858     '("rput" LaTeX-pst-macro-rput t)
 859     '("rput*" LaTeX-pst-macro-rput t)
 860     '("cput" [LaTeX-pst-parameters]
 861       (TeX-arg-eval LaTeX-pst-angle) LaTeX-pst-point-in-parens t)
 862     '("uput" LaTeX-pst-macro-uput t)
 863     '("multirput" (LaTeX-pst-macro-multirputps t) t)
 864     '("multips" (LaTeX-pst-macro-multirputps nil) t)))
 865  LaTeX-dialect)
 866
 867 (defvar LaTeX-pstricks-package-options
 868   '("97" "plain" "DIA" "vtex" "distiller" "noxcolor")
 869   "Package options for pstricks.")
 870
 871 ;;; pstricks.el ends here