881 lines
33 KiB
EmacsLisp
881 lines
33 KiB
EmacsLisp
;;; pstricks.el --- AUCTeX style for the `pstricks' package. -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2007-2022 Free Software Foundation, Inc.
|
|
|
|
;; Author: Holger Sparr <holger.sparr@gmx.net>
|
|
;; Maintainer: auctex-devel@gnu.org
|
|
;; Created: 2007-06-14
|
|
;; Keywords: tex
|
|
|
|
;; This file is part of AUCTeX.
|
|
|
|
;; AUCTeX is free software; you can redistribute it and/or modify it
|
|
;; under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
|
;; any later version.
|
|
|
|
;; AUCTeX is distributed in the hope that it will be useful, but
|
|
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;; General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with AUCTeX; see the file COPYING. If not, write to the Free
|
|
;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
|
|
;; 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; AUCTeX style file for PSTricks
|
|
;;
|
|
;; Support for basic PSTricks macros and their arguments. Separate
|
|
;; history variables for point, angle, ... arguments.
|
|
;;
|
|
;; Parameter input completion together with input completion for certain
|
|
;; parameters (e.g. linestyle, linecolor and the like).
|
|
;;
|
|
;; There is a PSTricks-specific support for adding new parameters to
|
|
;; existing parameter lists or changing existing ones in optional
|
|
;; macro arguments. You might want to make those available through
|
|
;; key bindings by using something like
|
|
;; (define-key LaTeX-mode-map (kbd "C-c p a")
|
|
;; 'LaTeX-pst-parameter-add)
|
|
;; (define-key LaTeX-mode-map (kbd "C-c p c")
|
|
;; 'LaTeX-pst-parameter-change-value)
|
|
;; in a personal style file for PSTricks.
|
|
|
|
;;; History:
|
|
;;
|
|
;; 14/06/2007 rewrite of pstricks.el based on Jean-Philippe Georget's
|
|
;; pstricks.el version found on <URI:
|
|
;; https://www.emacswiki.org/emacs/pstricks.el>
|
|
|
|
;;; TODO:
|
|
;;
|
|
;; -- Use alist or hash-table for parameter input
|
|
;; -- Add more regularly used PSTricks macros
|
|
;; -- Prevent errors in AUCTeX modes other than LaTeX mode.
|
|
;; -- Check if the functionality for adding and changing parameters
|
|
;; can be generalized.
|
|
|
|
;;; Code:
|
|
|
|
(require 'tex)
|
|
(require 'latex)
|
|
(eval-when-compile
|
|
(require 'cl-lib))
|
|
|
|
;;; General Functions
|
|
|
|
(defun TeX-arg-compl-list (list &optional prompt hist)
|
|
"Input a value after PROMPT with completion from LIST and HISTORY."
|
|
(let ((first (car list)))
|
|
(if (and first (listp first))
|
|
(let ((func (nth 0 first))
|
|
(prompt (concat (or (nth 1 first) prompt) ": "))
|
|
(compl (nth 2 first))
|
|
(hist (or (nth 3 first) hist))
|
|
(crm-separator (nth 4 first))
|
|
res)
|
|
(setq list (cdr list))
|
|
(cond ((eq func #'completing-read-multiple)
|
|
(setq res (funcall func prompt list nil compl nil hist))
|
|
(mapconcat #'identity res crm-separator))
|
|
((eq func #'completing-read)
|
|
(setq res
|
|
(funcall func prompt list nil compl nil hist)))))
|
|
(completing-read (concat prompt ": ") list nil nil nil hist))))
|
|
|
|
;; XXX: Show default value in prompt. Perhaps extend
|
|
;; `TeX-argument-prompt' to do that.
|
|
(defun LaTeX-pst-what (what prompt default &optional arg)
|
|
"Ask for WHAT with PROMPT with DEFAULT.
|
|
The corresponding lists LaTeX-pst-<what>-\\(list\\|history\\)
|
|
have to exist.
|
|
|
|
\(Used to define functions named LaTeX-pst-<what>.\))"
|
|
(let ((list (intern (concat "LaTeX-pst-" what "-list")))
|
|
(hist (intern (concat "LaTeX-pst-" what "-history"))))
|
|
(if (not arg)
|
|
(setq arg (TeX-arg-compl-list (symbol-value list) prompt hist)))
|
|
(if (string= arg "")
|
|
default
|
|
(add-to-list list arg)
|
|
arg)))
|
|
|
|
(defun LaTeX-pst-input-int (prompt arg)
|
|
"Return number as string asked for with PROMPT if no number
|
|
passed with ARG."
|
|
(unless (numberp arg)
|
|
(setq arg (read-number (concat prompt ": ") 2)))
|
|
(number-to-string arg))
|
|
|
|
(defun LaTeX-pst-enclose-obj (symbol op cl)
|
|
"Enclose string returned by the `funcall' SYMBOL in OP and CL
|
|
character."
|
|
(let ((str (funcall symbol)))
|
|
(if str (insert (char-to-string op) str (char-to-string cl)))))
|
|
|
|
(defun LaTeX-package-parameter-value (param pname)
|
|
"Ask for possible value of parameter PARAM given as string
|
|
available through package name PNAME and return \"param=value\"."
|
|
(add-to-list (intern (concat "LaTeX-" pname "-parameters-name-list"))
|
|
param)
|
|
;; select predefined set
|
|
(let* ((cregexp
|
|
(symbol-value
|
|
(intern (concat "LaTeX-" pname
|
|
"-parameters-completion-regexp"))))
|
|
(bregexp
|
|
(symbol-value (intern (concat "LaTeX-" pname
|
|
"-parameters-boolean-regexp"))))
|
|
(parlist (cond
|
|
((string-match cregexp param)
|
|
(intern (concat "LaTeX-" pname "-"
|
|
(match-string 0 param) "-list")))
|
|
((string-match bregexp param)
|
|
'LaTeX-pst-boolean-list)))
|
|
val compl)
|
|
;; ask for value
|
|
(setq val (TeX-arg-compl-list
|
|
(symbol-value parlist)
|
|
(concat "(Press TAB for completions) " param)
|
|
(intern (concat "LaTeX-" pname
|
|
"-parameters-value-history"))))
|
|
;; FIXME: This looks broken. `compl' is never set and unless ""
|
|
;; is added to parlist (at least in the Boolean case), the prompt
|
|
;; shown by `TeX-arg-compl-list' will be incorrect.
|
|
(if (and (not compl) parlist) (add-to-list parlist val))
|
|
(if (string= val "") "" (concat param "=" val))))
|
|
|
|
(defun LaTeX-package-parameters-pref-and-chosen (param pname noskip)
|
|
"Set values for elements of PARAM from package PNAME and
|
|
further explicitly typed in parameters and return a comma
|
|
separated list as string."
|
|
(let ((allpars "")
|
|
(fask (intern (concat "LaTeX-" pname "-parameter-value")))
|
|
tpara parval)
|
|
(when param
|
|
(while param
|
|
(setq tpara (pop param))
|
|
(setq parval (funcall fask tpara))
|
|
(setq allpars
|
|
(concat allpars
|
|
(if (or (string= "" allpars) (string= "" parval))
|
|
"" ",") parval))))
|
|
;; ask for parameter names as long as none is given
|
|
(when noskip
|
|
(while
|
|
(not
|
|
(string=
|
|
""
|
|
(setq tpara
|
|
(completing-read
|
|
"Parameter name (RET to stop): "
|
|
(symbol-value (intern
|
|
(concat "LaTeX-" pname
|
|
"-parameters-name-list")))
|
|
nil nil nil (intern
|
|
(concat "LaTeX-" pname
|
|
"-parameters-name-history"))))))
|
|
(setq parval (funcall fask tpara))
|
|
;; concat param=value with other ones
|
|
(setq allpars
|
|
(concat allpars
|
|
(if (or (string= "" allpars) (string= "" parval))
|
|
""
|
|
",")
|
|
parval))))
|
|
(add-to-list
|
|
(intern (concat "LaTeX-" pname "-parameters-history")) allpars)
|
|
allpars))
|
|
|
|
(defun LaTeX-package-parameters (optional pname preparam param)
|
|
"Ask for parameters and manage several parameter lists for
|
|
package PNAME"
|
|
(let ((fask (intern
|
|
(concat "LaTeX-" pname "-parameters-pref-and-chosen")))
|
|
(hlist (intern (concat "LaTeX-" pname "-parameters-history")))
|
|
(nlist
|
|
(symbol-value
|
|
(intern (concat "LaTeX-" pname "-parameters-name-list")))))
|
|
;;
|
|
(when (and preparam (listp preparam))
|
|
(setq preparam (funcall fask preparam)))
|
|
;;
|
|
(setq param
|
|
(TeX-completing-read-multiple
|
|
(concat
|
|
"Params (use <Up,Down> for history or RET for choices): ")
|
|
nlist nil nil nil hlist))
|
|
;;
|
|
(if (not param)
|
|
(setq param (funcall fask nil t))
|
|
(setq param (car (symbol-value hlist))))
|
|
(TeX-argument-insert
|
|
(if (or (string= "" preparam) (eq preparam nil))
|
|
param
|
|
(concat preparam (if (string= "" param) "" (concat "," param))))
|
|
optional)))
|
|
|
|
;;; Points
|
|
(defvar LaTeX-pst-point-list (list "0,0")
|
|
"A list of values for point in pstricks.")
|
|
|
|
(defvar LaTeX-pst-point-history LaTeX-pst-point-list
|
|
"History of values for point in pstricks.")
|
|
|
|
(defun LaTeX-pst-point ()
|
|
"Ask for a point and manage point list."
|
|
(LaTeX-pst-what "point"
|
|
(concat "Point (default " (car LaTeX-pst-point-history) ")")
|
|
(car LaTeX-pst-point-history)))
|
|
|
|
(defun LaTeX-pst-point-in-parens (_optional)
|
|
"Enclose point in parentheses."
|
|
(LaTeX-pst-enclose-obj 'LaTeX-pst-point ?\( ?\)))
|
|
|
|
;;; Angles
|
|
(defvar LaTeX-pst-angle-list (list "0")
|
|
"A list of values for angle in pstricks.")
|
|
|
|
(defvar LaTeX-pst-angle-history nil
|
|
"History of values for angle in pstricks.")
|
|
|
|
(defun LaTeX-pst-angle ()
|
|
"Ask for a angle and manage angle list"
|
|
(LaTeX-pst-what "angle"
|
|
(concat "Angle (default " (car LaTeX-pst-angle-list) ")")
|
|
(car LaTeX-pst-angle-list)))
|
|
|
|
;;; Extension in one Direction
|
|
(defvar LaTeX-pst-extdir-list (list "1")
|
|
"A list of values for extdir in pstricks.")
|
|
|
|
(defvar LaTeX-pst-extdir-history nil
|
|
"History of values for extdir in pstricks.")
|
|
|
|
(defun LaTeX-pst-extdir (descr)
|
|
"Ask for a extdir and manage extdir list"
|
|
(LaTeX-pst-what "extdir"
|
|
(concat descr " (default " (car LaTeX-pst-extdir-list) ")")
|
|
(car LaTeX-pst-extdir-list)))
|
|
|
|
;;; Relative Points
|
|
(defvar LaTeX-pst-delpoint-list nil
|
|
"A list of values for delpoint in pstricks.")
|
|
|
|
(defvar LaTeX-pst-delpoint-history nil
|
|
"History of values for delpoint in pstricks.")
|
|
|
|
;;; Arrows
|
|
(defvar LaTeX-pst-arrows-list
|
|
'("->" "<-" "<->" ">-<" ">-" "-<" "<<->>" "<<-" "->>" "|-|" "|-" "-|"
|
|
"|*-|*" "[-]" "[-" "-]" "(-)" "(-" "-)" "*-*" "*-" "-*" "0-0" "0-"
|
|
"-0" "c-c" "c-" "-c" "C-C" "C-" "-C" "cc-cc" "cc-" "-cc" "|<->|" "|<-"
|
|
"->|" "|<*->|*" "|<*-" "->|*" "-")
|
|
"A list of values for arrows in pstricks.")
|
|
|
|
(defvar LaTeX-pst-arrows-history nil
|
|
"History of values for arrows in pstricks.")
|
|
|
|
;; XXX: Better ask for arrow start and end separately?
|
|
;; `LaTeX-pst-arrows-list' is not exhaustive.
|
|
(defun LaTeX-pst-arrows ()
|
|
"Ask for a arrow type and manage arrow type list"
|
|
(or (LaTeX-pst-what "arrows" "Arrow type" nil) ""))
|
|
|
|
;;; Dots
|
|
(defvar LaTeX-pst-dotstyle-list
|
|
'((completing-read "Dot style" nil LaTeX-pst-dotstyle-history)
|
|
"*" "o" "+" "|" "triangle" "triangle*" "square" "square*" "pentagon"
|
|
"pentagon*")
|
|
"A list of values for dotstyle in pstricks.")
|
|
|
|
(defvar LaTeX-pst-dotstyle-history nil
|
|
"History of values for dotstyle in pstricks.")
|
|
|
|
;;; Reference Point
|
|
(defvar LaTeX-pst-refpoint-list
|
|
'((completing-read "Reference point" t LaTeX-pst-refpoint-history)
|
|
"l" "r" "t" "tl" "lt" "tr" "rt" "b" "bl" "br" "lb" "rb" "B" "Bl"
|
|
"Br" "lB" "rB")
|
|
"A list of values for refpoint in pstricks.")
|
|
|
|
(defvar LaTeX-pst-refpoint-history nil
|
|
"History of values for refpoint in pstricks.")
|
|
|
|
(defun LaTeX-pst-refpoint ()
|
|
"Ask for a refpoint and manage refpoint list"
|
|
(LaTeX-pst-what "refpoint" "Reference point" nil))
|
|
|
|
;;; Color
|
|
|
|
;; FIXME: Still used?
|
|
(defvar LaTeX-pst-color-history nil
|
|
"History of values for color in pstricks.")
|
|
|
|
;;; Others without History in Completion
|
|
|
|
(defvar LaTeX-pst-style-list
|
|
'((completing-read "Defined Style" t))
|
|
"A list of values for user defined styles in pstricks.")
|
|
|
|
;;; Parameters
|
|
|
|
(defvar LaTeX-pst-parameters-history nil
|
|
"History of values for parameters in pstricks.")
|
|
|
|
(defvar LaTeX-pst-parameters-value-history nil
|
|
"History of parameter values in pstricks.")
|
|
|
|
(defvar LaTeX-pst-basic-parameters-name-list
|
|
'("arcsep" "arcsepA" "arcsepB" "arrowinset" "arrowlength" "arrows"
|
|
"arrowscale" "arrowsize" "border" "bordercolor" "boxsep"
|
|
"bracketlength" "cornersize" "curvature" "dash" "dimen" "dotangle"
|
|
"dotscale" "dotsep" "dotsize" "dotstyle" "doublecolor" "doubleline"
|
|
"doublesep" "doubleset" "fillcolor" "fillstyle" "framearc"
|
|
"framesep" "gangle" "gridcolor" "griddots" "gridlabelcolor"
|
|
"gridlabels" "gridwidth" "hatchangle" "hatchcolor" "hatchsep"
|
|
"hatchsepinc" "hatchwidth" "hatchwidthinc" "header" "labelsep"
|
|
"liftpen" "linearc" "linecolor" "linestyle" "linetype" "linewidth"
|
|
"rbracketlength" "ref" "runit" "shadow" "shadowangle" "shadowcolor"
|
|
"shadowsize" "showgrid" "showpoints" "style" "subgridcolor"
|
|
"subgriddiv" "subgriddots" "subgridwidth" "swapaxes" "tbarsize"
|
|
"trimode" "unit" "xunit" "yunit")
|
|
"A list of parameter names in pstricks.")
|
|
|
|
|
|
(defvar LaTeX-pst-boolean-list '("true" "false")
|
|
"List of binary values for key=value completion.")
|
|
|
|
;; XXX: Colors can actually be given as [-]<color>[!<num>].
|
|
(defvar LaTeX-pst-color-list
|
|
'("black" "darkgray" "gray" "lightgray" "white"
|
|
"red" "green" "blue" "cyan" "magenta" "yellow")
|
|
"List of colors predefined in PSTricks.")
|
|
|
|
(defvar LaTeX-pst-fillstyle-list
|
|
'("none" "solid" "vlines" "vlines*" "hlines" "hlines*" "crosshatch"
|
|
"crosshatch*" "boxfill")
|
|
"List of fill styles defined in PSTricks.")
|
|
|
|
;; From PSTricks: PostScript macros for Generic TeX, User's Guide,
|
|
;; Timothy Van Zandt, 25 July 2003, Version 97.
|
|
;; FIXME: Provide separate variables tailored to the different macros.
|
|
(defvar LaTeX-pst-basic-parameters-list
|
|
'(;; Dimensions, coordinates and angles
|
|
("unit")
|
|
("xunit")
|
|
("yunit")
|
|
("runit")
|
|
;; Basic graphics parameters
|
|
("linewidth")
|
|
("linecolor" LaTeX-pst-color-list)
|
|
("fillstyle" LaTeX-pst-fillstyle-list)
|
|
("fillcolor" LaTeX-pst-color-list)
|
|
("arrows" LaTeX-pst-arrows-list)
|
|
("showpoints" LaTeX-pst-boolean-list)
|
|
;; Lines and polygons
|
|
("linearc")
|
|
("framearc")
|
|
("cornersize" ("relative" "absolute"))
|
|
("gangle")
|
|
;; Arcs, circles and ellipses
|
|
("arcsepA")
|
|
("arcsepB")
|
|
("arcsep")
|
|
;; Curves
|
|
("curvature")
|
|
;; Dots
|
|
("dotstyle" ("*" "o" "Bo" "x" "+" "B+" "asterisk" "Basterisk" "oplus"
|
|
"otimes" "|" "B|" "square" "Bsquare" "square*" "diamond"
|
|
"Bdiamond" "diamond*" "triangle" "Btriangle" "triangle*"
|
|
"pentagon" "Bpentagon" "pentagon*"))
|
|
("dotsize")
|
|
("dotscale")
|
|
("dotangle")
|
|
;; Grids
|
|
("gridwidth")
|
|
("gridcolor" LaTeX-pst-color-list)
|
|
("griddots")
|
|
("gridlabels")
|
|
("gridlabelcolor" LaTeX-pst-color-list)
|
|
("subgriddiv")
|
|
("subgridwidth")
|
|
("subgridcolor" LaTeX-pst-color-list)
|
|
("subgriddots")
|
|
;; Plots
|
|
("plotstyle" ("dots" "line" "polygon" "curve" "ecurve" "ccurve"))
|
|
("plotpoints")
|
|
;; Coordinate systems
|
|
("origin")
|
|
("swapaxes" LaTeX-pst-boolean-list)
|
|
;; Line styles
|
|
("linestyle" ("none" "solid" "dashed" "dotted"))
|
|
("dash")
|
|
("dotsep")
|
|
("border")
|
|
("bordercolor" LaTeX-pst-color-list)
|
|
("doubleline" LaTeX-pst-boolean-list)
|
|
("doublesep")
|
|
("doublecolor" LaTeX-pst-color-list)
|
|
("shadow" LaTeX-pst-boolean-list)
|
|
("shadowsize")
|
|
("shadowangle")
|
|
("shadowcolor" LaTeX-pst-color-list)
|
|
("dimen" ("outer" "inner" "middle"))
|
|
;; Fill styles
|
|
("hatchwidth")
|
|
("hatchsep")
|
|
("hatchcolor" LaTeX-pst-color-list)
|
|
("hatchangle")
|
|
("addfillstyle" LaTeX-pst-fillstyle-list)
|
|
;; Arrowheads and such
|
|
("arrowsize")
|
|
("arrowlength")
|
|
("arrowwinset")
|
|
("tbarsize")
|
|
("bracketlength")
|
|
("rbracketlength")
|
|
("arrowscale")
|
|
;; Parameters
|
|
("linetype")
|
|
;; Graphics objects
|
|
("liftpen")
|
|
;; Placing and rotating whatever
|
|
("labelsep")
|
|
;; Axes
|
|
("labels" ("all" "x" "y" "none"))
|
|
("showorigin" LaTeX-pst-boolean-list)
|
|
("ticks" ("all" "x" "y" "none"))
|
|
("tickstyle" ("full" "top" "bottom"))
|
|
("ticksize")
|
|
("axesstyle" ("axes" "frame" "none"))
|
|
;; Framed boxes
|
|
("framesep")
|
|
("boxsep")
|
|
("trimode" ("*" "U" "D" "R" "L"))
|
|
;; Nodes
|
|
("href")
|
|
("vref")
|
|
("radius")
|
|
;; Node connections
|
|
("nodesep")
|
|
("arcangle")
|
|
("angle")
|
|
("arm")
|
|
("loopsize")
|
|
("ncurv")
|
|
("boxsize")
|
|
("offset")
|
|
;; Node connections labels: I
|
|
("ref")
|
|
("nrot")
|
|
("npos")
|
|
("shortput" ("none" "nab" "tablr" "tab"))
|
|
;; Node connection labels: II
|
|
("tpos")
|
|
;; Attaching labels to nodes
|
|
("rot")
|
|
;; Mathematical diagrams and graphs
|
|
("mnode" ("R" "r" "C" "f" "p" "circle" "oval" "dia" "tri" "dot" "none"))
|
|
("emnode" ("R" "r" "C" "f" "p" "circle" "oval" "dia" "tri" "dot" "none"))
|
|
("name")
|
|
("nodealign" LaTeX-pst-boolean-list)
|
|
("mcol" ("l" "r" "c"))
|
|
("rowsep")
|
|
("colsep")
|
|
("mnodesize")
|
|
;; ...
|
|
)
|
|
"List of keys and values for PSTricks macro arguments.")
|
|
|
|
(defvar LaTeX-pst-parameters-name-list
|
|
LaTeX-pst-basic-parameters-name-list
|
|
"A list of all parameters with completion.")
|
|
|
|
(defvar LaTeX-pst-parameters-name-history nil
|
|
"History of parameter names in pstricks.")
|
|
|
|
(defvar LaTeX-pst-parameters-completion-regexp
|
|
"\\(arrows\\|linestyle\\|fillstyle\\|color\\|trimode\\|dotstyle\\|\\<style\\)"
|
|
"Regexp for `string-match'ing a parameter.")
|
|
|
|
(defvar LaTeX-pst-parameters-boolean-regexp
|
|
"\\(doubleline\\|shadow\\>\\|show[a-zA-Z]+\\)"
|
|
"Regexp for `string-match'ing a parameter.")
|
|
|
|
(defun LaTeX-pst-parameter-value (param)
|
|
"See documentation of `LaTeX-package-parameter-value'."
|
|
(LaTeX-package-parameter-value param "pst"))
|
|
|
|
(defun LaTeX-pst-parameters-pref-and-chosen (param &optional noskip)
|
|
"See documentation of `LaTeX-package-parameters-pref-and-chosen'."
|
|
(LaTeX-package-parameters-pref-and-chosen param "pst" noskip))
|
|
|
|
;; FIXME: This is likely only a transitional function used until all
|
|
;; macros got their calls to `TeX-arg-key-val' with tailored parameter
|
|
;; lists.
|
|
(defun LaTeX-pst-parameters (optional)
|
|
"Prompt for general parameters of a PSTricks argument."
|
|
(TeX-arg-key-val optional LaTeX-pst-basic-parameters-list))
|
|
|
|
;;; Macros
|
|
(defun LaTeX-pst-macro-psarc (_optional &optional _arg)
|
|
"Return \\psarc arguments after querying."
|
|
(let ((arrows (LaTeX-pst-arrows))
|
|
(pnt (if current-prefix-arg nil (LaTeX-pst-point))))
|
|
(insert (if arrows (format "{%s}" arrows) "")
|
|
(if pnt (format "(%s)" pnt) "")
|
|
"{" (LaTeX-pst-extdir "Radius") "}{" (LaTeX-pst-angle) "}{"
|
|
(LaTeX-pst-angle) "}")))
|
|
|
|
(defun LaTeX-pst-macro-pscircle (_optional &optional _arg)
|
|
"Return \\pscircle arguments after querying."
|
|
(insert "(" (LaTeX-pst-point) "){" (LaTeX-pst-extdir "Radius") "}"))
|
|
|
|
(defun LaTeX-pst-macro-rput (_optional &optional _arg)
|
|
"Return \\rput arguments after querying."
|
|
(let ((refpoint (LaTeX-pst-refpoint))
|
|
(rotation (if current-prefix-arg (LaTeX-pst-angle) nil)))
|
|
(insert (if refpoint (concat "[" refpoint "]") "")
|
|
(if rotation
|
|
(concat "{" rotation "}")
|
|
"") "(" (LaTeX-pst-point) ")")))
|
|
|
|
(defun LaTeX-pst-macro-uput (_optional &optional _arg)
|
|
"Return \\uput arguments after querying."
|
|
(let ((dist (LaTeX-pst-extdir "Distance"))
|
|
(refpoint (LaTeX-pst-refpoint)))
|
|
(insert (if dist (concat "{" dist "}") "")
|
|
(if refpoint
|
|
(concat "[" (LaTeX-pst-refpoint) "]")
|
|
"[]")
|
|
"{" (LaTeX-pst-angle) "}(" (LaTeX-pst-point) ")")))
|
|
|
|
(defun LaTeX-pst-macro-multirputps (_optional &optional _arg)
|
|
"Return \\multirput or \\multips arguments after querying."
|
|
(let ((refpoint (LaTeX-pst-refpoint))
|
|
(rotation (if current-prefix-arg (LaTeX-pst-angle) nil))
|
|
(pnt (LaTeX-pst-point))
|
|
(dpnt (LaTeX-pst-what "delpoint" "Increment (default 1,1)" "1,1"))
|
|
(repi (LaTeX-pst-input-int "Repetitions" nil)))
|
|
(insert (if refpoint (format "[%s]" refpoint) "")
|
|
(if rotation (format "{%s}" rotation) "")
|
|
"(" pnt ")(" dpnt "){" repi "}")))
|
|
|
|
(defun LaTeX-pst-macro-psline (_optional &optional _arg)
|
|
"Return \\psline or \\ps[ce]?curve[*] arguments after querying."
|
|
(let ((arrows (LaTeX-pst-arrows))
|
|
(pnt1 (LaTeX-pst-point))
|
|
(pnt2 (LaTeX-pst-point)))
|
|
(insert (if arrows (format "{%s}" arrows) "") "(" pnt1 ")" )
|
|
(while (and (not (string= pnt2 "")) (not (string= pnt1 pnt2)))
|
|
(insert "(" pnt2 ")")
|
|
(setq pnt1 pnt2)
|
|
(setq pnt2 (LaTeX-pst-point)))))
|
|
|
|
(defun LaTeX-pst-macro-psdots (_optional single)
|
|
"Return \\psdot[s]? arguments after querying."
|
|
(let* ((pnt1 (LaTeX-pst-point))
|
|
(pnt2 (if single pnt1 (LaTeX-pst-point))))
|
|
(insert "(" pnt1 ")")
|
|
(while (and (not (string= pnt2 "")) (not (string= pnt1 pnt2)))
|
|
(setq pnt1 pnt2)
|
|
(insert "(" pnt1 ")")
|
|
(setq pnt2 (LaTeX-pst-point)))))
|
|
|
|
(defun LaTeX-pst-macro-parabola (_optional &optional _arg)
|
|
"Return \\parabola arguments after querying."
|
|
(let ((arrows (LaTeX-pst-arrows)))
|
|
(insert (if arrows (format "{%s}" arrows) "")
|
|
"(" (LaTeX-pst-point) ")(" (LaTeX-pst-point) ")")))
|
|
|
|
(defun LaTeX-pst-macro-pnt-twolen (_optional prompt1 prompt2)
|
|
"Return point and 2 paired lengths in separate parens as arguments."
|
|
;; insert \psellipse[*]?, \psdiamond or \pstriangle arguments
|
|
(let ((pnt (if current-prefix-arg nil (LaTeX-pst-point))))
|
|
(insert (if pnt (format "(%s)" pnt) "")
|
|
"(" (LaTeX-pst-extdir prompt1) ","
|
|
(LaTeX-pst-extdir prompt2) ")")))
|
|
|
|
(defun LaTeX-pst-macro-psbezier (_optional &optional _arg)
|
|
"Return \\psbezier arguments after querying."
|
|
(let ((arrows (LaTeX-pst-arrows))
|
|
(pnt1 (LaTeX-pst-point))
|
|
(pnt2 (LaTeX-pst-point))
|
|
(pnt3 (LaTeX-pst-point)))
|
|
(insert (if arrows (format "{%s}" arrows) "")
|
|
"(" pnt1 ")(" pnt2 ")")
|
|
(while (not (string= pnt2 pnt3))
|
|
(insert "(" pnt3 ")")
|
|
(setq pnt2 pnt3)
|
|
(setq pnt3 (LaTeX-pst-point)))))
|
|
|
|
(defun LaTeX-pst-macro-pspolygon (_optional &optional _arg)
|
|
"Return \\pspolygon arguments after querying."
|
|
(let ((pnt1 (LaTeX-pst-point))
|
|
(pnt2 (LaTeX-pst-point))
|
|
(pnt3 (LaTeX-pst-point)))
|
|
(insert "(" pnt1 ")(" pnt2 ")")
|
|
(while (not (string= pnt2 pnt3))
|
|
(insert "(" pnt3 ")")
|
|
(setq pnt2 pnt3)
|
|
(setq pnt3 (LaTeX-pst-point)))))
|
|
|
|
(defun LaTeX-pst-macro-psframe (_optional &optional _arg)
|
|
"Return \\psframe arguments after querying."
|
|
(let ((pnt1 (if current-prefix-arg nil (LaTeX-pst-point)))
|
|
(pnt2 (LaTeX-pst-point)))
|
|
(insert (if pnt1 (format "(%s)" pnt1) "") "(" pnt2 ")")))
|
|
|
|
(defun LaTeX-pst-macro-psgrid (_optional &optional _arg)
|
|
"Return \\psgrid arguments after querying."
|
|
(let* ((cpref (if current-prefix-arg (car current-prefix-arg) 0))
|
|
(pnt1 (if (> cpref 4) (LaTeX-pst-point) nil))
|
|
(pnt2 (if (> cpref 0) (LaTeX-pst-point) nil))
|
|
(pnt3 (if (> cpref 0) (LaTeX-pst-point) nil)))
|
|
(insert (if pnt1 (format "(%s)" pnt1) "")
|
|
(if pnt2 (format "(%s)(%s)" pnt2 pnt3) ""))))
|
|
|
|
(defun LaTeX-pst-macro-newpsobject (&optional _arg)
|
|
"Return \\newpsobject arguments after querying."
|
|
(insert "{" (TeX-read-string "New PSObject Name: ") "}"
|
|
;; FIXME: It would be better to use something more confined
|
|
;; than `TeX-symbol-list'.
|
|
"{" (completing-read "Parent Object: " (TeX-symbol-list))
|
|
"}"))
|
|
|
|
;;; Environments
|
|
(defun LaTeX-pst-env-pspicture (env)
|
|
"Create new pspicure environment."
|
|
(let ((opt (multi-prompt-key-value
|
|
(TeX-argument-prompt t "Options" nil)
|
|
'(("showgrid") ("shift"))))
|
|
(p0 (LaTeX-pst-what "point" "Lower left (default 0,0)" "0,0"))
|
|
(p1 (LaTeX-pst-what "point" "Upper right (default 1,1)" "1,1"))
|
|
corn)
|
|
(setq corn (concat (unless (string= "" opt) (format "[%s]" opt))
|
|
(if (string= "0,0" p0) "" (format "(%s)" p0))
|
|
"(" p1 ")"))
|
|
(LaTeX-insert-environment env corn)))
|
|
|
|
;;; Self Parsing -- see (info "(auctex)Hacking the Parser")
|
|
(defvar LaTeX-auto-pstricks-regexp-list
|
|
'(("\\\\newps\\(object\\){\\([a-zA-Z]+\\)}{\\([a-zA-Z]+\\)}" (1 2 3)
|
|
LaTeX-auto-pstricks)
|
|
("\\\\newps\\(fontdot\\){\\([a-zA-Z]+\\)}" (1 2)
|
|
LaTeX-auto-pstricks)
|
|
("\\\\newps\\(style\\){\\([a-zA-Z]+\\)}" (1 2)
|
|
LaTeX-auto-pstricks)
|
|
("\\\\define\\(color\\){\\([a-zA-Z]+\\)}{\\(rgb\\|cmyk\\)}" (1 2 3)
|
|
LaTeX-auto-pstricks)
|
|
("\\\\new\\(rgb\\|hsb\\|cmyk\\)\\(color\\){\\([a-zA-Z]+\\)}" (2 3 1)
|
|
LaTeX-auto-pstricks))
|
|
"List of regular expressions to extract arguments of \\newps* macros.")
|
|
|
|
(defvar LaTeX-auto-pstricks nil
|
|
"Temporary for parsing \\newps* definitions.")
|
|
|
|
(defun LaTeX-pst-cleanup ()
|
|
"Move symbols from `LaTeX-auto-pstricks' to `TeX-auto-symbol'."
|
|
(mapcar
|
|
(lambda (list)
|
|
(let ((type (car list)))
|
|
(cond ((string= type "object")
|
|
(setq TeX-auto-symbol
|
|
(cons (list (nth 1 list)
|
|
(cl-caddr (assoc (nth 2 list)
|
|
(TeX-symbol-list))))
|
|
TeX-auto-symbol)))
|
|
((string= type "fontdot")
|
|
(add-to-list 'LaTeX-pst-dotstyle-list (nth 1 list) t))
|
|
((string= type "style")
|
|
(add-to-list 'LaTeX-pst-style-list (nth 1 list) t))
|
|
((string= type "color")
|
|
(add-to-list 'LaTeX-pst-color-list (nth 1 list) t)
|
|
;; FIXME: Why is an entry with "-" in front added?
|
|
(add-to-list 'LaTeX-pst-color-list
|
|
(concat "-" (nth 1 list)) t)))))
|
|
LaTeX-auto-pstricks))
|
|
|
|
(defun LaTeX-pst-prepare ()
|
|
"Clear `LaTeX-auto-pstricks' before use."
|
|
(setq LaTeX-auto-pstricks nil))
|
|
|
|
(add-hook 'TeX-auto-prepare-hook #'LaTeX-pst-prepare t)
|
|
(add-hook 'TeX-auto-cleanup-hook #'LaTeX-pst-cleanup )
|
|
(add-hook 'TeX-update-style-hook #'TeX-auto-parse t)
|
|
|
|
;;; Additional Functionality
|
|
(defun LaTeX-pst-parameters-add (&optional arg)
|
|
"With ARG as prefix-argument insert new parameter\(s\) behind
|
|
nearest backward LaTeX macro in brackets. Without ARG add
|
|
parameter\(s\) to the already existing ones at the end of the
|
|
comma separated list. Point has to be within the sexp to modify."
|
|
(interactive "P")
|
|
(let ((newpara (LaTeX-pst-parameters-pref-and-chosen nil t))
|
|
(regexp "\\(") end check)
|
|
(if arg
|
|
(progn
|
|
(re-search-backward "\\\\\\([a-zA-Z]\\)")
|
|
(forward-word 1)
|
|
(insert-pair nil ?\[ ?\]))
|
|
(up-list 1)
|
|
(backward-char 1)
|
|
(save-excursion
|
|
(setq end (point))
|
|
(up-list -1)
|
|
(while (re-search-forward "\\([a-zA-Z]+\\)=" end 'limit)
|
|
(setq regexp (concat regexp
|
|
(match-string-no-properties 1) "\\|")))
|
|
(setq regexp (concat (substring regexp 0 -1) ")"))
|
|
(setq check (string-match regexp newpara))))
|
|
(when newpara
|
|
(insert (if arg "" ",") newpara)
|
|
(when check
|
|
(message
|
|
"At least one Parameters appears twice. PLEASE CHECK!")))))
|
|
;; FIXME: Only define a key for this once it is a general-purpose
|
|
;; facility, i.e. not just for pstricks but all types of macros.
|
|
;; (define-key LaTeX-mode-map "\C-c\C-x\C-a" 'LaTeX-pst-parameters-add)
|
|
|
|
(defvar LaTeX-pst-value-regexp
|
|
"\\([-!.a-zA-Z0-9]*\\s\\?[-!.a-zA-Z0-9]+\\)"
|
|
"Expression matching a parameter value.")
|
|
|
|
(defun LaTeX-pst-parameter-remove-value ()
|
|
"Remove value of current parameter and return parameter name."
|
|
(re-search-backward
|
|
(concat "\\(\\s(\\|,\\)[a-zA-Z]+\\([a-zA-Z]\\|=\\|="
|
|
LaTeX-pst-value-regexp "\\)"))
|
|
(re-search-forward "\\([a-zA-Z]+\\)=")
|
|
(let ((para (match-string-no-properties 1)))
|
|
(re-search-forward LaTeX-pst-value-regexp)
|
|
(delete-region (match-beginning 1) (match-end 1))
|
|
para))
|
|
|
|
(defun LaTeX-pst-parameter-change-value ()
|
|
"Replace parameter value with a new one."
|
|
(interactive)
|
|
(let* ((para (LaTeX-pst-parameter-remove-value))
|
|
(symb
|
|
(when (and
|
|
(string-match
|
|
LaTeX-pst-parameters-completion-regexp para)
|
|
(boundp
|
|
(intern
|
|
(concat "LaTeX-pst-" (match-string 0 para) "-list"))))
|
|
(intern (concat "LaTeX-pst-" (match-string 0 para)
|
|
"-list")))))
|
|
(insert (TeX-arg-compl-list (symbol-value symb) "New Value"
|
|
'LaTeX-pst-parameters-value-history))))
|
|
;; FIXME: Only define a key for this once it is a general-purpose
|
|
;; facility, i.e. not just for pstricks but all types of macros. (See
|
|
;; also `LaTeX-pst-parameters-add'. Note that a parameter change
|
|
;; should better be made available through a `C-u' prefix of the
|
|
;; binding for the function doing the parameter addition.)
|
|
;; (define-key LaTeX-mode-map "\C-c\C-x\C-v" 'LaTeX-pst-parameter-change-value)
|
|
|
|
(TeX-add-style-hook
|
|
"pstricks"
|
|
(lambda ()
|
|
(unless (or (member "pst-pdf" TeX-active-styles)
|
|
(eq TeX-engine 'xetex))
|
|
;; Leave at user's choice whether to disable `TeX-PDF-mode' or
|
|
;; not. Instead set up `TeX-PDF-from-DVI' option so that AUCTeX
|
|
;; takes dvips+ps2pdf route when `TeX-PDF-mode' is enabled.
|
|
;; (TeX-PDF-mode-off)
|
|
(setq TeX-PDF-from-DVI "Dvips"))
|
|
(mapc #'TeX-auto-add-regexp LaTeX-auto-pstricks-regexp-list)
|
|
(LaTeX-add-environments
|
|
'("pspicture" LaTeX-pst-env-pspicture)
|
|
"overlaybox" "psclip")
|
|
(TeX-add-symbols
|
|
'("AltClipMode" 0) '("DontKillGlue" 0) '("KillGlue" 0)
|
|
'("NormalCoor" 0) '("SpecialCoor" 0) '("PSTricksLoaded" 0)
|
|
'("PSTricksOff" 0) '("altcolormode" 0) '("pslinecolor" 0)
|
|
'("pslinestyle" 0) '("pslinetype" 0) '("pslinewidth" 0)
|
|
'("pslabelsep" 0) '("radian" 0) '("psunit" 0) '("psrunit" 0)
|
|
'("psxunit" 0) '("psyunit" 0)
|
|
'("arrows" (TeX-arg-eval LaTeX-pst-arrows))
|
|
'("clipbox" ["Border"] t)
|
|
'("closedshadow" [LaTeX-pst-parameters])
|
|
'("openshadow" [LaTeX-pst-parameters])
|
|
"closepath" "code" "coor" "curveto" "degrees" "dim" "endpsclip"
|
|
"file" "fill" "grestore" "gsave" "lineto" "movepath" "moveto"
|
|
"mrestore" "msave" "newpath" "rcoor" "rcurveto" "rlineto" "rotate"
|
|
"scale" "stroke" "swapaxes" "translate"
|
|
'("newcmykcolor" "Name" "Quadruple")
|
|
'("newrgbcolor" "Name" "Triple") '("newhsbcolor" "Name" "Triple")
|
|
'("newgray" "Name" "Value")
|
|
'("newpsobject" LaTeX-pst-macro-newpsobject LaTeX-pst-parameters)
|
|
'("newpsstyle" "New PSStyle Name" LaTeX-pst-parameters)
|
|
'("newpsfontdot" "New PSDot Name" ["Factors"]
|
|
"Fontname" "Character Number (Hex)")
|
|
'("parabola" [LaTeX-pst-parameters] LaTeX-pst-macro-parabola)
|
|
'("parabola*" [LaTeX-pst-parameters] LaTeX-pst-macro-parabola)
|
|
'("psarc" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
|
|
'("psarc*" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
|
|
'("psarcn" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
|
|
'("pswedge" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
|
|
'("psbezier" [LaTeX-pst-parameters] LaTeX-pst-macro-psbezier)
|
|
'("psbezier*" [LaTeX-pst-parameters] LaTeX-pst-macro-psbezier)
|
|
'("pscbezier" [LaTeX-pst-parameters] LaTeX-pst-macro-pspolygon)
|
|
'("pscircle" [LaTeX-pst-parameters] LaTeX-pst-macro-pscircle)
|
|
'("psccurve" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
|
|
'("psccurve*" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
|
|
'("pscurve" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
|
|
'("pscurve*" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
|
|
'("pscustom" [LaTeX-pst-parameters])
|
|
'("psdiamond" [LaTeX-pst-parameters]
|
|
(LaTeX-pst-macro-pnt-twolen "Width" "Height"))
|
|
'("pstriangle" [LaTeX-pst-parameters]
|
|
(LaTeX-pst-macro-pnt-twolen "Width" "Height"))
|
|
'("psdot" [LaTeX-pst-parameters] (LaTeX-pst-macro-psdots t))
|
|
'("psdots" [LaTeX-pst-parameters] (LaTeX-pst-macro-psdots nil))
|
|
'("psecurve" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
|
|
'("psecurve*" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
|
|
'("psellipse" [LaTeX-pst-parameters]
|
|
(LaTeX-pst-macro-pnt-twolen "Radius x" "Radius y"))
|
|
'("psellipse*" [LaTeX-pst-parameters]
|
|
(LaTeX-pst-macro-pnt-twolen "Radius x" "Radius y"))
|
|
'("psframe" [LaTeX-pst-parameters] LaTeX-pst-macro-psframe)
|
|
'("psframe*" [LaTeX-pst-parameters] LaTeX-pst-macro-psframe)
|
|
'("psframebox" [LaTeX-pst-parameters] t)
|
|
'("pscirclebox" [LaTeX-pst-parameters] t)
|
|
'("psdblframebox" [LaTeX-pst-parameters] t)
|
|
'("psdiabox" [LaTeX-pst-parameters] t)
|
|
'("psovalbox" [LaTeX-pst-parameters] t)
|
|
'("psshadowbox" [LaTeX-pst-parameters] t)
|
|
'("pstribox" [LaTeX-pst-parameters] t)
|
|
'("psscalebox" "Scaling Factor(s)" t)
|
|
'("psscaleboxto" LaTeX-pst-point-in-parens t)
|
|
'("psgrid" [LaTeX-pst-parameters] LaTeX-pst-macro-psgrid 0)
|
|
'("psline" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
|
|
'("psoverlay" t)
|
|
'("pspolygon" [LaTeX-pst-parameters] LaTeX-pst-macro-pspolygon)
|
|
'("pspolygon*" [LaTeX-pst-parameters] LaTeX-pst-macro-pspolygon)
|
|
'("psset" LaTeX-pst-parameters)
|
|
'("pssetlength" TeX-arg-macro "Length")
|
|
'("psaddtolength" TeX-arg-macro "Length")
|
|
'("degrees" ["Full Circle"])
|
|
'("qdisk" LaTeX-pst-point-in-parens "Radius")
|
|
'("qline" LaTeX-pst-point-in-parens LaTeX-pst-point-in-parens)
|
|
"pslongbox" "psrotatedown" "psrotateleft" "psrotateright"
|
|
'("rput" LaTeX-pst-macro-rput t)
|
|
'("rput*" LaTeX-pst-macro-rput t)
|
|
'("cput" [LaTeX-pst-parameters]
|
|
(TeX-arg-eval LaTeX-pst-angle) LaTeX-pst-point-in-parens t)
|
|
'("uput" LaTeX-pst-macro-uput t)
|
|
'("multirput" (LaTeX-pst-macro-multirputps t) t)
|
|
'("multips" (LaTeX-pst-macro-multirputps nil) t)))
|
|
TeX-dialect)
|
|
|
|
(defvar LaTeX-pstricks-package-options
|
|
'("97" "plain" "DIA" "vtex" "distiller" "noxcolor")
|
|
"Package options for pstricks.")
|
|
|
|
;;; pstricks.el ends here
|