"Fossies" - the Fresh Open Source Software Archive

Member "auctex-12.3/style/pstricks.el" (18 Oct 2020, 33714 Bytes) of package /linux/misc/auctex-12.3.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Lisp source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "pstricks.el": 12.2_vs_12.3.

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