auctex-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[AUCTeX-diffs] Changes to auctex/style/pstricks.el,v


From: Holger Sparr
Subject: [AUCTeX-diffs] Changes to auctex/style/pstricks.el,v
Date: Mon, 23 Feb 2009 17:20:37 +0000

CVSROOT:        /sources/auctex
Module name:    auctex
Changes by:     Holger Sparr <hsparr>   09/02/23 17:20:34

Index: pstricks.el
===================================================================
RCS file: /sources/auctex/auctex/style/pstricks.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- pstricks.el 3 Feb 2008 14:53:29 -0000       1.3
+++ pstricks.el 23 Feb 2009 17:20:33 -0000      1.4
@@ -25,19 +25,685 @@
 ;; 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).
 
-;; Add support for PSTricks.
+;;; History:
+;;
+;; 14/06/2007 rewrite of pstricks.el based on Jean-Philippe Georget's
+;;            pstricks.el version found on <URI:
+;;            http://www.emacswiki.org/cgi-bin/wiki/pstricks.el>
 
-;; TODO: Actually implement support.  Currently only TeX PDF mode is
-;; turned off.  This is done here because adding the hook in latex.el
-;; prevents other pstricks styles from being loaded.
+;;; TODO:
+;;
+;; -- use alist or hash-table for parameter input
+;; -- adding more regularly used PSTricks macros
 
 ;;; Code:
 
 (TeX-add-style-hook
  "pstricks"
+ (function
  (lambda ()
-   (unless (member "pst-pdf" TeX-active-styles)
-     (TeX-PDF-mode-off))))
+    (mapcar '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 - separate by SPC: "]
+       "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-macro-psdots t])
+     '("psdots" [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)))))
+
+;;; 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))))
+
+(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"))))
+    (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
+          (completing-read-multiple
+           (concat
+            "Params (use <Up,Down> for history or RET for choices): ")
+           nlist nil nil nil hlist))
+    ;;
+    (if (and  (string= "" (car param)) (= (length param) 1))
+        (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 [" (car LaTeX-pst-point-history) "]")
+                  (car LaTeX-pst-point-history)))
+
+(defun LaTeX-pst-point-in-parens (optional)
+  "Enclose Point in parenthesis."
+  (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 [" (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 " [" (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.")
+
+(defun LaTeX-pst-arrows ()
+  "Ask for a arrow type and manage arrow type list"
+  (LaTeX-pst-what "arrows"
+                  "Arrow Type [->,... Press TAB for more]" nil))
+
+;;; Dots
+(defvar LaTeX-pst-dotstyle-list
+  '((completing-read "Dotsyle" 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 "RefPoint" 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"
+                  "RefPoint [t,tl,... - Press TAB for all]" nil))
+
+;;; Color
+(defvar LaTeX-pst-color-list
+  '((completing-read-multiple
+     "Color (C1 [number [C1 [...]]])" t LaTeX-pst-color-history "!")
+    "black" "darkgray" "gray" "lightgray" "white" "-black" "-darkgray"
+    "-gray" "-lightgray" "-white" "red" "green" "blue" "yellow"
+    "magenta" "cyan" "-red" "-green" "-blue" "-yellow" "-magenta"
+    "-cyan" "violet" "purple" "brown" "pink" "olive" "-violet" "-purple"
+    "-brown" "-pink" "-olive"
+    "10" "20" "30" "40" "50" "60" "70" "80" "90")
+  "A list of values for *color in pstricks.")
+
+(defvar LaTeX-pst-color-history nil
+  "History of values for color in pstricks.")
+
+;;; Others without History in Completion
+(defvar LaTeX-pst-trimode-list
+  '((completing-read "Trimode" t) "U" "*U" "D" "*D" "R" "*R" "L" "*L")
+  "A list of values for trimode in pstribox.")
+
+(defvar LaTeX-pst-linestyle-list
+  '((completing-read "Linestyle" t) "none" "dashed" "dotted" "solid")
+  "A list of values for linestyle in pstricks.")
+
+(defvar LaTeX-pst-boolean-list
+  '((completing-read "Boolean" t) "true" "false")
+  "A list of values for boolean in pstricks.")
+
+(defvar LaTeX-pst-fillstyle-list
+  '((completing-read "Fillstyle" t)
+    "none" "solid" "vlines" "vlines*" "hlines" "hlines*" "crosshatch"
+    "crosshatch*")
+  "A list of values for fillstyle in pstricks.")
+
+(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-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))
+
+(defun LaTeX-pst-parameters (optional &optional preparam param)
+  "See documentation of `LaTeX-package-parameters-pref-and-chosen'."
+  (LaTeX-package-parameters optional "pst" preparam param))
+
+;;; 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 [delx,dely]" "1,1"))
+        (repi (LaTeX-pst-input-int "Repititions" 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."
+  ;; forced parameter dotstyle
+  (LaTeX-pst-parameters optional '("dotstyle"))
+  (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 "{" (read-string "New PSObject Name: ") "}"
+          "{" (completing-read "Parent Object: " (TeX-symbol-list))
+          "}"))
+
+;;; Environments
+(defun LaTeX-pst-env-pspicture (env)
+  "Create new pspicure environment."
+  (let ((p0 (LaTeX-pst-what "point" "LowerLeft [default 0,0]" "0,0"))
+        (p1 (LaTeX-pst-what "point" "UpperRight [default 1,1]" "1,1"))
+        (grid (LaTeX-pst-parameters-pref-and-chosen '("showgrid")))
+        corn)
+    (setq corn (concat (if (string= "" grid) "" (format "[%s]" grid))
+                       (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)
+                                (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)
+              (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)
+(add-hook 'TeX-auto-cleanup-hook 'LaTeX-pst-cleanup)
+
+;;; 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 "\\(") beg 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!")))))
+(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))))
+(define-key LaTeX-mode-map "\C-c\C-x\C-v" 'LaTeX-pst-parameter-change-value)
 
 ;;; pstricks.el ends here




reply via email to

[Prev in Thread] Current Thread [Next in Thread]