lisp/progmodes/ps-mode.el

   1 ;;; ps-mode.el --- PostScript mode for GNU Emacs.
   2
   3 ;; Copyright (C) 1999 Free Software Foundation, Inc.
   4
   5 ;; Author:     Peter Kleiweg <kleiweg@let.rug.nl>
   6 ;; Maintainer: Peter Kleiweg <kleiweg@let.rug.nl>
   7 ;; Created:    20 Aug 1997
   8 ;; Version:    1.1e, 11 Nov 1999
   9 ;; Keywords:   PostScript, languages
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 \f
  31 ;;; Code:
  32
  33 (defconst ps-mode-version "1.1e, 11 Nov 1999")
  34 (defconst ps-mode-maintainer-address "Peter Kleiweg <kleiweg@let.rug.nl>")
  35
  36 (require 'easymenu)
  37
  38 ;; Define core `PostScript' group.
  39 (defgroup PostScript nil
  40   "PostScript mode for Emacs."
  41   :group 'languages)
  42
  43 (defgroup PostScript-edit nil
  44   "PostScript editing."
  45   :prefix "ps-mode-"
  46   :group 'PostScript)
  47
  48 (defgroup PostScript-interaction nil
  49   "PostScript interaction."
  50   :prefix "ps-run-"
  51   :group 'PostScript)
  52
  53 ;; User variables.
  54
  55 (defcustom ps-mode-auto-indent t
  56   "*Should we use autoindent?"
  57   :group 'PostScript-edit
  58   :type 'boolean)
  59
  60 (defcustom ps-mode-tab 4
  61   "*Number of spaces to use when indenting."
  62   :group 'PostScript-edit
  63   :type 'integer)
  64
  65 (defcustom ps-mode-paper-size '(595 842)
  66   "*Default paper size.
  67
  68 When inserting an EPSF template these values are used
  69 to set the boundingbox to include the whole page.
  70 When the figure is finished these values should be replaced."
  71   :group 'PostScript-edit
  72   :type '(choice
  73           (const :tag "letter"       (612  792))
  74           (const :tag "legal"        (612 1008))
  75           (const :tag "a0"          (2380 3368))
  76           (const :tag "a1"          (1684 2380))
  77           (const :tag "a2"          (1190 1684))
  78           (const :tag "a3"           (842 1190))
  79           (const :tag "a4"           (595  842))
  80           (const :tag "a5"           (421  595))
  81           (const :tag "a6"           (297  421))
  82           (const :tag "a7"           (210  297))
  83           (const :tag "a8"           (148  210))
  84           (const :tag "a9"           (105  148))
  85           (const :tag "a10"           (74  105))
  86           (const :tag "b0"          (2836 4008))
  87           (const :tag "b1"          (2004 2836))
  88           (const :tag "b2"          (1418 2004))
  89           (const :tag "b3"          (1002 1418))
  90           (const :tag "b4"           (709 1002))
  91           (const :tag "b5"           (501  709))
  92           (const :tag "archE"       (2592 3456))
  93           (const :tag "archD"       (1728 2592))
  94           (const :tag "archC"       (1296 1728))
  95           (const :tag "archB"        (864 1296))
  96           (const :tag "archA"        (648  864))
  97           (const :tag "flsa"         (612  936))
  98           (const :tag "flse"         (612  936))
  99           (const :tag "halfletter"   (396  612))
 100           (const :tag "11x17"        (792 1224))
 101           (const :tag "tabloid"      (792 1224))
 102           (const :tag "ledger"      (1224  792))
 103           (const :tag "csheet"      (1224 1584))
 104           (const :tag "dsheet"      (1584 2448))
 105           (const :tag "esheet"      (2448 3168))))
 106
 107 (defcustom ps-mode-print-function
 108   '(lambda ()
 109      (let ((lpr-switches nil)
 110            (lpr-command (if (memq system-type '(usg-unix-v dgux hpux irix))
 111                             "lp" "lpr")))
 112        (lpr-buffer)))
 113   "*Lisp function to print current buffer as PostScript."
 114   :group 'PostScript-edit
 115   :type 'function)
 116
 117 (defcustom ps-run-prompt "\\(GS\\(<[0-9]+\\)?>\\)+"
 118   "*Regexp to match prompt in interactive PostScript."
 119   :group 'PostScript-interaction
 120   :type 'regexp)
 121
 122 (defcustom ps-run-font-lock-keywords-2
 123   (append (unless (string= ps-run-prompt "")
 124             (list (list (if (= ?^ (string-to-char ps-run-prompt))
 125                             ps-run-prompt
 126                           (concat "^" ps-run-prompt))
 127                         '(0 font-lock-function-name-face nil nil))))
 128           '((">>showpage, press <return> to continue<<"
 129              (0 font-lock-keyword-face nil nil))
 130             ("^\\(Error\\|Can't\\).*"
 131              (0 font-lock-warning-face nil nil))
 132             ("^\\(Current file position is\\) \\([0-9]+\\)"
 133              (1 font-lock-comment-face nil nil)
 134              (2 font-lock-warning-face nil nil))))
 135   "*Medium level highlighting of messages from the PostScript interpreter.
 136
 137 See documentation on font-lock for details."
 138   :group 'PostScript-interaction
 139   :type '(repeat (list :tag "Expression with one or more highlighters"
 140                        :value ("" (0 default nil t))
 141                        (regexp :tag "Expression")
 142                        (repeat :tag "Highlighters"
 143                                :inline regexp
 144                                (list :tag "Highlighter"
 145                                      (integer :tag "Subexp")
 146                                      face
 147                                      (boolean :tag "Override")
 148                                      (boolean :tag "Laxmatch" :value t))))))
 149
 150 (defcustom ps-run-x '("gs" "-r72" "-sPAPERSIZE=a4")
 151   "*Command as list to run PostScript with graphic display."
 152   :group 'PostScript-interaction
 153   :type '(repeat string))
 154
 155 (defcustom ps-run-dumb '("gs" "-dNODISPLAY")
 156   "*Command as list to run PostScript without graphic display."
 157   :group 'PostScript-interaction
 158   :type '(repeat string))
 159
 160 (defcustom ps-run-init nil
 161   "*String of commands to send to PostScript to start interactive.
 162
 163 Example: \"executive\"
 164
 165 You won't need to set this option for Ghostscript.
 166 "
 167   :group 'PostScript-interaction
 168   :type '(choice (const nil) string))
 169
 170 (defcustom ps-run-error-line-numbers nil
 171   "*What values are used by the PostScript interpreter in error messages?"
 172   :group 'PostScript-interaction
 173   :type '(choice (const :tag "line numbers" t)
 174                  (const :tag "byte counts" nil)))
 175
 176 (defcustom ps-run-tmp-dir nil
 177   "*Name of directory to place temporary file.
 178
 179 If nil, the following are tried in turn, until success:
 180   1. \"$TEMP\"
 181   2. \"$TMP\"
 182   3. \"$HOME/tmp\"
 183   4. \"/tmp\"
 184 "
 185   :group 'PostScript-interaction
 186   :type '(choice (const nil) directory))
 187
 188 \f
 189 ;; Constants used for font-lock.
 190
 191 ;; Only a small set of the PostScript operators is selected for fontification.
 192 ;; Fontification is meant to clarify the document structure and process flow,
 193 ;; fontifying all known PostScript operators would hinder that objective.
 194 (defconst ps-mode-operators
 195   (let ((ops '("clear" "mark" "cleartomark" "counttomark"
 196                "forall"
 197                "dict" "begin" "end" "def"
 198                "true" "false"
 199                "exec" "if" "ifelse" "for" "repeat" "loop" "exit"
 200                "stop" "stopped" "countexecstack" "execstack"
 201                "quit" "start"
 202                "save" "restore"
 203                "bind" "null"
 204                "gsave" "grestore" "grestoreall"
 205                "showpage")))
 206     (concat "\\<" (regexp-opt ops t) "\\>"))
 207   "Regexp of PostScript operators that will be fontified")
 208
 209 ;; Level 1 font-lock:
 210 ;;  - Special comments (reference face)
 211 ;;  - Strings and other comments
 212 ;;  - Partial strings (warning face)
 213 ;;  - 8bit characters (warning face)
 214 ;; Multiline strings are not supported. Strings with nested brackets are.
 215 (defconst ps-mode-font-lock-keywords-1
 216   '(("\\`%!PS.*" . font-lock-reference-face)
 217     ("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$"
 218      . font-lock-reference-face)
 219     (ps-mode-match-string-or-comment
 220      (1 font-lock-comment-face nil t)
 221      (2 font-lock-string-face nil t))
 222     ("([^()\n%]*\\|[^()\n]*)" . font-lock-warning-face)
 223     ("[\200-\377]+" (0 font-lock-warning-face prepend nil)))
 224   "Subdued level highlighting for PostScript mode.")
 225
 226 ;; Level 2 font-lock:
 227 ;;  - All from level 1
 228 ;;  - PostScript operators (keyword face)
 229 (defconst ps-mode-font-lock-keywords-2
 230   (append
 231    ps-mode-font-lock-keywords-1
 232    (list
 233     (cons
 234      ;; exclude names prepended by `/'
 235      (concat "\\(^\\|[^/\n]\\)" ps-mode-operators)
 236      '(2 font-lock-keyword-face))))
 237   "Medium level highlighting for PostScript mode.")
 238
 239 ;; Level 3 font-lock:
 240 ;;  - All from level 2
 241 ;;  - Immediately evaluated names: those starting with `//' (type face)
 242 ;;  - Names that look like they are used for the definition of:
 243 ;;     * a function
 244 ;;     * an array
 245 ;;     * a dictionary
 246 ;;     * a "global" variable
 247 ;;    (function name face)
 248 ;;  - Other names (variable name face)
 249 ;; The rules used to determine what names fit in the first category are:
 250 ;;  - Only names that are at the left margin, and one of these on the same line:
 251 ;;     * Nothing after the name except possibly one or more `[' or a comment
 252 ;;     * A `{' or `<<' or `[0-9]+ dict' following the name
 253 ;;     * A `def' somewhere in the same line
 254 ;; Names are fontified before PostScript operators, allowing the use of
 255 ;; a more simple (efficient) regexp than the one used in level 2.
 256 (defconst ps-mode-font-lock-keywords-3
 257   (append
 258    ps-mode-font-lock-keywords-1
 259    (list
 260     '("//\\w+" . font-lock-type-face)
 261     '("^\\(/\\w+\\)\\>[[ \t]*\\(%.*\\)?\r?$"
 262       . (1 font-lock-function-name-face))
 263     '("^\\(/\\w+\\)\\>\\([ \t]*{\\|[ \t]*<<\\|.*\\<def\\>\\|[ \t]+[0-9]+[ \t]+dict\\>\\)"
 264       . (1 font-lock-function-name-face))
 265     '("/\\w+" . font-lock-variable-name-face)
 266     (cons ps-mode-operators 'font-lock-keyword-face)))
 267   "High level highliting for PostScript mode.")
 268
 269 (defconst ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1
 270   "Default expressions to highlight in PostScript mode.")
 271
 272 ;; Level 1 font-lock for ps-run-mode
 273 ;;  - prompt (function name face)
 274 (defconst ps-run-font-lock-keywords-1
 275   (unless (string= "" ps-run-prompt)
 276     (list (cons (if (= ?^ (string-to-char ps-run-prompt))
 277                     ps-run-prompt
 278                   (concat "^" ps-run-prompt))
 279                 'font-lock-function-name-face)))
 280   "Subdued level highlighting for PostScript run mode.")
 281
 282 (defconst ps-run-font-lock-keywords ps-run-font-lock-keywords-1
 283   "Default expressions to highlight in PostScript run mode.")
 284
 285 \f
 286 ;; Variables.
 287
 288 (defvar ps-mode-map nil
 289   "Local keymap to use in PostScript mode.")
 290
 291 (defvar ps-mode-syntax-table nil
 292   "Syntax table used while in PostScript mode.")
 293
 294 (defvar ps-run-mode-map nil
 295   "Local keymap to use in PostScript run mode.")
 296
 297 (defvar ps-mode-tmp-file nil
 298   "Name of temporary file, set by `ps-run'.")
 299
 300 (defvar ps-run-mark nil
 301   "Mark to start of region that was sent to PostScript interpreter.")
 302
 303 (defvar ps-run-parent nil
 304   "Parent window of interactive PostScript.")
 305
 306 \f
 307 ;; Menu
 308
 309 (defconst ps-mode-menu-main
 310   '("PostScript"
 311     ["EPSF Template, Sparse" ps-mode-epsf-sparse t]
 312     ["EPSF Template, Rich"   ps-mode-epsf-rich t]
 313     "---"
 314     ("Cookbook"
 315      ["RE" ps-mode-RE t]
 316      ["ISOLatin1Extended" ps-mode-latin-extended t]
 317      ["center" ps-mode-center t]
 318      ["right" ps-mode-right t]
 319      ["Heapsort" ps-mode-heapsort t])
 320     ("Fonts (1)"
 321      ["Times-Roman" (insert "/Times-Roman ") t]
 322      ["Times-Bold" (insert "/Times-Bold ") t]
 323      ["Times-Italic" (insert "/Times-Italic ") t]
 324      ["Times-BoldItalic" (insert "/Times-BoldItalic ") t]
 325      ["Helvetica" (insert "/Helvetica ") t]
 326      ["Helvetica-Bold" (insert "/Helvetica-Bold ") t]
 327      ["Helvetica-Oblique" (insert "/Helvetica-Oblique ") t]
 328      ["Helvetica-BoldOblique" (insert "/Helvetica-BoldOblique ") t]
 329      ["Courier" (insert "/Courier ") t]
 330      ["Courier-Bold" (insert "/Courier-Bold ") t]
 331      ["Courier-Oblique" (insert "/Courier-Oblique ") t]
 332      ["Courier-BoldOblique" (insert "/Courier-BoldOblique ") t]
 333      ["Symbol" (insert "/Symbol") t ])
 334     ("Fonts (2)"
 335      ["AvantGarde-Book" (insert "/AvantGarde-Book ") t]
 336      ["AvantGarde-Demi" (insert "/AvantGarde-Demi ") t]
 337      ["AvantGarde-BookOblique" (insert "/AvantGarde-BookOblique ") t]
 338      ["AvantGarde-DemiOblique" (insert "/AvantGarde-DemiOblique ") t]
 339      ["Bookman-Light" (insert "/Bookman-Light ") t]
 340      ["Bookman-Demi" (insert "/Bookman-Demi ") t]
 341      ["Bookman-LightItalic" (insert "/Bookman-LightItalic ") t]
 342      ["Bookman-DemiItalic" (insert "/Bookman-DemiItalic ") t]
 343      ["Helvetica-Narrow" (insert "/Helvetica-Narrow ") t]
 344      ["Helvetica-Narrow-Bold" (insert "/Helvetica-Narrow-Bold ") t]
 345      ["Helvetica-Narrow-Oblique" (insert "/Helvetica-Narrow-Oblique ") t]
 346      ["Helvetica-Narrow-BoldOblique" (insert "/Helvetica-Narrow-BoldOblique ") t]
 347      ["NewCenturySchlbk-Roman" (insert "/NewCenturySchlbk-Roman ") t]
 348      ["NewCenturySchlbk-Bold" (insert "/NewCenturySchlbk-Bold ") t]
 349      ["NewCenturySchlbk-Italic" (insert "/NewCenturySchlbk-Italic ") t]
 350      ["NewCenturySchlbk-BoldItalic" (insert "/NewCenturySchlbk-BoldItalic ") t]
 351      ["Palatino-Roman" (insert "/Palatino-Roman ") t]
 352      ["Palatino-Bold" (insert "/Palatino-Bold ") t]
 353      ["Palatino-Italic" (insert "/Palatino-Italic ") t]
 354      ["Palatino-BoldItalic" (insert "/Palatino-BoldItalic ") t]
 355      ["ZapfChancery-MediumItalic" (insert "/ZapfChancery-MediumItalic ") t]
 356      ["ZapfDingbats" (insert "/ZapfDingbats ") t])
 357     "---"
 358     ["Comment Out Region" ps-mode-comment-out-region (mark t)]
 359     ["Uncomment Region" ps-mode-uncomment-region (mark t)]
 360     "---"
 361     ["8-bit to Octal Buffer" ps-mode-octal-buffer t]
 362     ["8-bit to Octal Region" ps-mode-octal-region (mark t)]
 363     "---"
 364     ("Auto Indent"
 365      ["On" (setq ps-mode-auto-indent t) (not ps-mode-auto-indent)]
 366      ["Off" (setq ps-mode-auto-indent nil) ps-mode-auto-indent])
 367     "---"
 368     ["Start PostScript"
 369      ps-run-start
 370      t]
 371     ["Quit PostScript" ps-run-quit (process-status "ps-run")]
 372     ["Kill PostScript" ps-run-kill (process-status "ps-run")]
 373     ["Send Buffer to Interpreter"
 374      ps-run-buffer
 375      (process-status "ps-run")]
 376     ["Send Region to Interpreter"
 377      ps-run-region
 378      (and (mark t) (process-status "ps-run"))]
 379     ["Send Newline to Interpreter"
 380      ps-mode-other-newline
 381      (process-status "ps-run")]
 382     ["View BoundingBox"
 383      ps-run-boundingbox
 384      (process-status "ps-run")]
 385     ["Clear/Reset PostScript Graphics"
 386      ps-run-clear
 387      (process-status "ps-run")]
 388     "---"
 389     ["Print Buffer as PostScript"
 390      ps-mode-print-buffer
 391      t]
 392     ["Print Region as PostScript"
 393      ps-mode-print-region
 394      (mark t)]
 395     "---"
 396     ["Customize for PostScript"
 397      (customize-group "PostScript")
 398      t]
 399     "---"
 400     ["Submit Bug Report"
 401      ps-mode-submit-bug-report
 402      t]))
 403
 404 \f
 405 ;; Mode maps for PostScript edit mode and PostScript interaction mode.
 406
 407 (unless ps-mode-map
 408   (setq ps-mode-map (make-sparse-keymap))
 409   (define-key ps-mode-map "\C-cv"    'ps-mode-show-version)
 410   (define-key ps-mode-map "\C-c\C-v" 'ps-run-boundingbox)
 411   (define-key ps-mode-map "\C-c\C-u" 'ps-mode-uncomment-region)
 412   (define-key ps-mode-map "\C-c\C-t" 'ps-mode-epsf-rich)
 413   (define-key ps-mode-map "\C-c\C-s" 'ps-run-start)
 414   (define-key ps-mode-map "\C-c\C-r" 'ps-run-region)
 415   (define-key ps-mode-map "\C-c\C-q" 'ps-run-quit)
 416   (define-key ps-mode-map "\C-c\C-p" 'ps-mode-print-buffer)
 417   (define-key ps-mode-map "\C-c\C-o" 'ps-mode-comment-out-region)
 418   (define-key ps-mode-map "\C-c\C-k" 'ps-run-kill)
 419   (define-key ps-mode-map "\C-c\C-j" 'ps-mode-other-newline)
 420   (define-key ps-mode-map "\C-c\C-c" 'ps-run-clear)
 421   (define-key ps-mode-map "\C-c\C-b" 'ps-run-buffer)
 422   (define-key ps-mode-map ">" 'ps-mode-r-gt)
 423   (define-key ps-mode-map "]" 'ps-mode-r-angle)
 424   (define-key ps-mode-map "}" 'ps-mode-r-brace)
 425   (define-key ps-mode-map "\177" 'ps-mode-backward-delete-char)
 426   (define-key ps-mode-map "\t" 'ps-mode-tabkey)
 427   (define-key ps-mode-map "\r" 'ps-mode-newline)
 428   (define-key ps-mode-map [return] 'ps-mode-newline)
 429   (easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main))
 430
 431 (unless ps-run-mode-map
 432   (setq ps-run-mode-map (make-sparse-keymap))
 433   (define-key ps-run-mode-map "\C-c\C-q" 'ps-run-quit)
 434   (define-key ps-run-mode-map "\C-c\C-k" 'ps-run-kill)
 435   (define-key ps-run-mode-map "\C-c\C-e" 'ps-run-goto-error)
 436   (define-key ps-run-mode-map [mouse-2] 'ps-run-mouse-goto-error)
 437   (define-key ps-run-mode-map "\r" 'ps-run-newline)
 438   (define-key ps-run-mode-map [return] 'ps-run-newline))
 439
 440 \f
 441 ;; Syntax table.
 442
 443 (unless ps-mode-syntax-table
 444   (setq ps-mode-syntax-table (make-syntax-table))
 445
 446   (modify-syntax-entry ?\% "< " ps-mode-syntax-table)
 447   (modify-syntax-entry ?\n "> " ps-mode-syntax-table)
 448   (modify-syntax-entry ?\r "> " ps-mode-syntax-table)
 449   (modify-syntax-entry ?\f "> " ps-mode-syntax-table)
 450   (modify-syntax-entry ?\< "(>" ps-mode-syntax-table)
 451   (modify-syntax-entry ?\> ")<" ps-mode-syntax-table)
 452
 453   (modify-syntax-entry ?\! "w " ps-mode-syntax-table)
 454   (modify-syntax-entry ?\" "w " ps-mode-syntax-table)
 455   (modify-syntax-entry ?\# "w " ps-mode-syntax-table)
 456   (modify-syntax-entry ?\$ "w " ps-mode-syntax-table)
 457   (modify-syntax-entry ?\& "w " ps-mode-syntax-table)
 458   (modify-syntax-entry ?\' "w " ps-mode-syntax-table)
 459   (modify-syntax-entry ?\* "w " ps-mode-syntax-table)
 460   (modify-syntax-entry ?\+ "w " ps-mode-syntax-table)
 461   (modify-syntax-entry ?\, "w " ps-mode-syntax-table)
 462   (modify-syntax-entry ?\- "w " ps-mode-syntax-table)
 463   (modify-syntax-entry ?\. "w " ps-mode-syntax-table)
 464   (modify-syntax-entry ?\: "w " ps-mode-syntax-table)
 465   (modify-syntax-entry ?\; "w " ps-mode-syntax-table)
 466   (modify-syntax-entry ?\= "w " ps-mode-syntax-table)
 467   (modify-syntax-entry ?\? "w " ps-mode-syntax-table)
 468   (modify-syntax-entry ?\@ "w " ps-mode-syntax-table)
 469   (modify-syntax-entry ?\\ "w " ps-mode-syntax-table)
 470   (modify-syntax-entry ?^  "w " ps-mode-syntax-table) ; NOT: ?\^
 471   (modify-syntax-entry ?\_ "w " ps-mode-syntax-table)
 472   (modify-syntax-entry ?\` "w " ps-mode-syntax-table)
 473   (modify-syntax-entry ?\| "w " ps-mode-syntax-table)
 474   (modify-syntax-entry ?\~ "w " ps-mode-syntax-table)
 475
 476   (let ((i 128))
 477     (while (< i 256)
 478       (modify-syntax-entry i "w " ps-mode-syntax-table)
 479       (setq i (1+ i)))))
 480
 481 \f
 482 ;; PostScript mode.
 483
 484 ;;;###autoload
 485 (defun ps-mode ()
 486   "Major mode for editing PostScript with GNU Emacs.
 487
 488 Entry to this mode calls `ps-mode-hook'.
 489
 490 The following variables hold user options, and can
 491 be set through the `customize' command:
 492
 493   ps-mode-auto-indent
 494   ps-mode-tab
 495   ps-mode-paper-size
 496   ps-mode-print-function
 497   ps-run-prompt
 498   ps-run-font-lock-keywords-2
 499   ps-run-x
 500   ps-run-dumb
 501   ps-run-init
 502   ps-run-error-line-numbers
 503   ps-run-tmp-dir
 504
 505 Type \\[describe-variable] for documentation on these options.
 506
 507
 508 \\{ps-mode-map}
 509
 510
 511 When starting an interactive PostScript process with \\[ps-run-start],
 512 a second window will be displayed, and `ps-run-mode-hook' will be called.
 513 The keymap for this second window is:
 514
 515 \\{ps-run-mode-map}
 516
 517
 518 When Ghostscript encounters an error it displays an error message
 519 with a file position. Clicking mouse-2 on this number will bring
 520 point to the corresponding spot in the PostScript window, if input
 521 to the interpreter was sent from that window.
 522 Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect.
 523 "
 524   (interactive)
 525   (kill-all-local-variables)
 526   (make-local-variable 'font-lock-defaults)
 527   (setq font-lock-defaults '((ps-mode-font-lock-keywords
 528                               ps-mode-font-lock-keywords-1
 529                               ps-mode-font-lock-keywords-2
 530                               ps-mode-font-lock-keywords-3)
 531                              t)
 532         major-mode 'ps-mode
 533         mode-name  "PostScript")
 534   (use-local-map ps-mode-map)
 535   (set-syntax-table ps-mode-syntax-table)
 536   (run-hooks 'ps-mode-hook))
 537
 538 (defun ps-mode-show-version ()
 539   "Show current version of PostScript mode"
 540   (interactive)
 541   (message " *** PostScript Mode (ps-mode) Version %s *** " ps-mode-version))
 542
 543 (defun ps-mode-submit-bug-report ()
 544   "Submit via mail a bug report on PostScript mode"
 545   (interactive)
 546   (when (y-or-n-p "Submit bug report on PostScript mode? ")
 547     (let ((reporter-prompt-for-summary-p nil)
 548           (reporter-dont-compact-list '(ps-mode-print-function
 549                                         ps-run-font-lock-keywords-2)))
 550       (reporter-submit-bug-report
 551        ps-mode-maintainer-address
 552        (format "ps-mode.el %s [%s]" ps-mode-version system-type)
 553        '(ps-mode-auto-indent
 554          ps-mode-tab
 555          ps-mode-paper-size
 556          ps-mode-print-function
 557          ps-run-prompt
 558          ps-run-font-lock-keywords-2
 559          ps-run-x
 560          ps-run-dumb
 561          ps-run-init
 562          ps-run-error-line-numbers
 563          ps-run-tmp-dir)))))
 564
 565 \f
 566 ;; Helper functions for font-lock.
 567
 568 ;; When this function is called, point is at an opening bracket.
 569 ;; This function should test if point is at the start of a string
 570 ;; with nested brackets.
 571 ;; If true:  move point to end of string
 572 ;;           set string to match data nr 2
 573 ;;           return new point
 574 ;; If false: return nil
 575 (defun ps-mode-looking-at-nested (limit)
 576   (let ((first (point))
 577         (level 1)
 578         pos)
 579     ;; Move past opening bracket.
 580     (forward-char 1)
 581     (setq pos (point))
 582     (while (and (> level 0) (< pos limit))
 583       ;; Search next bracket, stepping over escaped brackets.
 584       (if (not (looking-at "\\([^()\\\n]\\|\\\\.\\)*\\([()]\\)"))
 585           (setq level -1)
 586         (if (string= "(" (match-string 2))
 587             (setq level (1+ level))
 588           (setq level (1- level)))
 589         (goto-char (setq pos (match-end 0)))))
 590     (if (not (= level 0))
 591         nil
 592       ;; Found string with nested brackets, now set match data nr 2.
 593       (goto-char first)
 594       (re-search-forward "\\(%\\)\\|\\((.*\\)" pos))))
 595
 596 ;; This function should search for a string or comment
 597 ;; If comment, return as match data nr 1
 598 ;; If string, return as match data nr 2
 599 (defun ps-mode-match-string-or-comment (limit)
 600   ;; Find the first potential match.
 601   (if (not (re-search-forward "[%(]" limit t))
 602       ;; Nothing found: return failure.
 603       nil
 604     (let (end)
 605       (goto-char (match-beginning 0))
 606       (setq end (match-end 0))
 607       (cond ((looking-at "\\(%.*\\)\\|\\((\\([^()\\\n]\\|\\\\.\\)*)\\)")
 608              ;; It's a comment or string without nested, unescaped brackets.
 609              (goto-char (match-end 0))
 610              (point))
 611             ((ps-mode-looking-at-nested limit)
 612              ;; It's a string with nested brackets.
 613              (point))
 614             (t
 615              ;; Try next match.
 616              (goto-char end)
 617              (ps-mode-match-string-or-comment limit))))))
 618
 619 \f
 620 ;; Key-handlers.
 621
 622 (defun ps-mode-target-column ()
 623   "To what column should text on current line be indented?
 624
 625 Identation is increased if the last token on the current line
 626 defines the beginning of a group. These tokens are:  {  [  <<"
 627   (save-excursion
 628     (beginning-of-line)
 629     (if (looking-at "[ \t]*\\(}\\|\\]\\|>>\\)")
 630         (condition-case err
 631             (progn
 632               (goto-char (match-end 0))
 633               (backward-sexp 1)
 634               (beginning-of-line)
 635               (if (looking-at "[ \t]+")
 636                   (goto-char (match-end 0)))
 637               (current-column))
 638           (error
 639            (ding)
 640            (message (error-message-string err))
 641            0))
 642       (let (target)
 643         (if (not (re-search-backward "[^ \t\n\r\f][ \t\n\r\f]*\\=" nil t))
 644             0
 645           (goto-char (match-beginning 0))
 646           (beginning-of-line)
 647           (if (looking-at "[ \t]+")
 648               (goto-char (match-end 0)))
 649           (setq target (current-column))
 650           (end-of-line)
 651           (if (re-search-backward "\\({\\|\\[\\|<<\\)[ \t]*\\(%[^\n]*\\)?\\=" nil t)
 652               (setq target (+ target ps-mode-tab)))
 653           target)))))
 654
 655 (defun ps-mode-newline ()
 656   "Insert newline with proper indentation."
 657   (interactive)
 658   (delete-horizontal-space)
 659   (insert "\n")
 660   (if ps-mode-auto-indent
 661       (indent-to (ps-mode-target-column))))
 662
 663 (defun ps-mode-tabkey ()
 664   "Indent/reindent current line, or insert tab"
 665   (interactive)
 666   (let ((column (current-column))
 667         target)
 668     (if (or (not ps-mode-auto-indent)
 669             (< ps-mode-tab 1)
 670             (not (re-search-backward "^[ \t]*\\=" nil t)))
 671         (insert "\t")
 672       (setq target (ps-mode-target-column))
 673       (while (<= target column)
 674         (setq target (+ target ps-mode-tab)))
 675       (delete-horizontal-space)
 676       (indent-to target))))
 677
 678 (defun ps-mode-backward-delete-char ()
 679   "Delete backward indentation, or delete backward character"
 680   (interactive)
 681   (let ((column (current-column))
 682         target)
 683     (if (or (not ps-mode-auto-indent)
 684             (< ps-mode-tab 1)
 685             (not (re-search-backward "^[ \t]+\\=" nil t)))
 686         (delete-backward-char 1)
 687       (setq target (ps-mode-target-column))
 688       (while (> column target)
 689         (setq target (+ target ps-mode-tab)))
 690       (while (>= target column)
 691         (setq target (- target ps-mode-tab)))
 692       (if (< target 0)
 693           (setq target 0))
 694       (delete-horizontal-space)
 695       (indent-to target))))
 696
 697 (defun ps-mode-r-brace ()
 698   "Insert `}' and perform balance."
 699   (interactive)
 700   (insert "}")
 701   (ps-mode-r-balance "}"))
 702
 703 (defun ps-mode-r-angle ()
 704   "Insert `]' and perform balance."
 705   (interactive)
 706   (insert "]")
 707   (ps-mode-r-balance "]"))
 708
 709 (defun ps-mode-r-gt ()
 710   "Insert `>' and perform balance."
 711   (interactive)
 712   (insert ">")
 713   (ps-mode-r-balance ">>"))
 714
 715 (defun ps-mode-r-balance (right)
 716   "Adjust indentification if point after RIGHT."
 717   (if ps-mode-auto-indent
 718       (save-excursion
 719         (when (re-search-backward (concat "^[ \t]*" (regexp-quote right) "\\=") nil t)
 720           (delete-horizontal-space)
 721           (indent-to (ps-mode-target-column)))))
 722   (blink-matching-open))
 723
 724 (defun ps-mode-other-newline ()
 725   "Perform newline in `*ps run*' buffer"
 726   (interactive)
 727   (let ((buf (current-buffer)))
 728     (set-buffer "*ps run*")
 729     (ps-run-newline)
 730     (set-buffer buf)))
 731
 732 \f
 733 ;; Print PostScript.
 734
 735 (defun ps-mode-print-buffer ()
 736   "Print buffer as PostScript"
 737   (interactive)
 738   (eval (list ps-mode-print-function)))
 739
 740 (defun ps-mode-print-region (begin end)
 741   "Print region as PostScript, adding minimal header and footer lines:
 742
 743 %!PS
 744 <region>
 745 showpage
 746 "
 747   (interactive "r")
 748   (let ((oldbuf (current-buffer))
 749         (tmpbuf (get-buffer-create "*ps print*")))
 750     (copy-to-buffer tmpbuf begin end)
 751     (set-buffer tmpbuf)
 752     (goto-char 1)
 753     (insert "%!PS\n")
 754     (goto-char (point-max))
 755     (insert "\nshowpage\n")
 756     (eval (list ps-mode-print-function))
 757     (set-buffer oldbuf)
 758     (kill-buffer tmpbuf)))
 759
 760 \f
 761 ;; Comment Out / Uncomment.
 762
 763 (defun ps-mode-comment-out-region (begin end)
 764   "Comment out region."
 765   (interactive "r")
 766   (let ((endm (make-marker)))
 767     (set-marker endm end)
 768     (save-excursion
 769       (goto-char begin)
 770       (if (= (current-column) 0)
 771           (insert "%"))
 772       (while (and (= (forward-line) 0)
 773                   (< (point) (marker-position endm)))
 774         (insert "%")))
 775     (set-marker endm nil)))
 776
 777 (defun ps-mode-uncomment-region (begin end)
 778   "Uncomment region.
 779
 780 Only one `%' is removed, and it has to be in the first column."
 781   (interactive "r")
 782   (let ((endm (make-marker)))
 783     (set-marker endm end)
 784     (save-excursion
 785       (goto-char begin)
 786       (if (looking-at "^%")
 787           (delete-char 1))
 788       (while (and (= (forward-line) 0)
 789                   (< (point) (marker-position endm)))
 790         (if (looking-at "%")
 791             (delete-char 1))))
 792     (set-marker endm nil)))
 793
 794 \f
 795 ;; Convert 8-bit to octal codes.
 796
 797 (defun ps-mode-octal-buffer ()
 798   "Change 8-bit characters to octal codes in buffer."
 799   (interactive)
 800   (ps-mode-octal-region (point-min) (point-max)))
 801
 802 (defun ps-mode-octal-region (begin end)
 803   "Change 8-bit characters to octal codes in region."
 804   (interactive "r")
 805   (if buffer-read-only
 806       (progn
 807         (ding)
 808         (message "Buffer is read only"))
 809     (save-excursion
 810       (let (endm i)
 811         (setq endm (make-marker))
 812         (set-marker endm end)
 813         (goto-char begin)
 814         (setq i 0)
 815         (while (re-search-forward "[\200-\377]" (marker-position endm) t)
 816           (setq i (1+ i))
 817           (backward-char)
 818           (insert (format "\\%03o" (string-to-char (buffer-substring (point) (1+ (point))))))
 819           (delete-char 1))
 820         (message "%d change%s made" i (if (= i 1) "" "s"))
 821         (set-marker endm nil)))))
 822
 823 \f
 824 ;; Cookbook.
 825
 826 (defun ps-mode-center ()
 827   "Insert function /center."
 828   (interactive)
 829   (insert "
 830 /center {
 831     dup stringwidth
 832     exch 2 div neg
 833     exch 2 div neg
 834     rmoveto
 835 } bind def
 836 "))
 837
 838 (defun ps-mode-right ()
 839   "Insert function /right."
 840   (interactive)
 841   (insert "
 842 /right {
 843     dup stringwidth
 844     exch neg
 845     exch neg
 846     rmoveto
 847 } bind def
 848 "))
 849
 850 (defun ps-mode-RE ()
 851   "Insert function /RE."
 852   (interactive)
 853   (insert "
 854 % `new-font-name' `encoding-vector' `old-font-name' RE -
 855 /RE {
 856     findfont
 857     dup maxlength dict begin {
 858         1 index /FID ne { def } { pop pop } ifelse
 859     } forall
 860     /Encoding exch def
 861     dup /FontName exch def
 862     currentdict end definefont pop
 863 } bind def
 864 "))
 865
 866 (defun ps-mode-latin-extended ()
 867   "Insert array /ISOLatin1Extended.
 868
 869 This encoding vector contains all the entries from ISOLatin1Encoding
 870 plus the usually uncoded characters inserted on positions 1 through 28.
 871 "
 872   (interactive)
 873   (insert "
 874 % ISOLatin1Encoding, extended with remaining uncoded glyphs
 875 /ISOLatin1Extended [
 876     /.notdef /Lslash /lslash /OE /oe /Scaron /scaron /Zcaron /zcaron
 877     /Ydieresis /trademark /bullet /dagger /daggerdbl /ellipsis /emdash
 878     /endash /fi /fl /florin /fraction /guilsinglleft /guilsinglright
 879     /perthousand /quotedblbase /quotedblleft /quotedblright
 880     /quotesinglbase /quotesingle /.notdef /.notdef /.notdef /space
 881     /exclam /quotedbl /numbersign /dollar /percent /ampersand
 882     /quoteright /parenleft /parenright /asterisk /plus /comma /minus
 883     /period /slash /zero /one /two /three /four /five /six /seven /eight
 884     /nine /colon /semicolon /less /equal /greater /question /at /A /B /C
 885     /D /E /F /G /H /I /J /K /L /M /N /O /P /Q /R /S /T /U /V /W /X /Y /Z
 886     /bracketleft /backslash /bracketright /asciicircum /underscore
 887     /quoteleft /a /b /c /d /e /f /g /h /i /j /k /l /m /n /o /p /q /r /s
 888     /t /u /v /w /x /y /z /braceleft /bar /braceright /asciitilde
 889     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
 890     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
 891     /.notdef /.notdef /.notdef /dotlessi /grave /acute /circumflex
 892     /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla
 893     /.notdef /hungarumlaut /ogonek /caron /space /exclamdown /cent
 894     /sterling /currency /yen /brokenbar /section /dieresis /copyright
 895     /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron
 896     /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
 897     /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright
 898     /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute
 899     /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute
 900     /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth
 901     /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
 902     /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn
 903     /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring
 904     /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave
 905     /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute
 906     /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute
 907     /ucircumflex /udieresis /yacute /thorn /ydieresis
 908 ] def
 909 "))
 910
 911 (defun ps-mode-heapsort ()
 912   "Insert function /Heapsort."
 913   (interactive)
 914   (insert "
 915 % `array-element' Heapsort-cvi-or-cvr-or-cvs `number-or-string'
 916 /Heapsort-cvi-or-cvr-or-cvs {
 917     % 0 get
 918 } bind def
 919 % `array' Heapsort `sorted-array'
 920 /Heapsort {
 921     dup length /hsR exch def
 922     /hsL hsR 2 idiv 1 add def
 923     {
 924         hsR 2 lt { exit } if
 925         hsL 1 gt {
 926             /hsL hsL 1 sub def
 927         } {
 928             /hsR hsR 1 sub def
 929             dup dup dup 0 get exch dup hsR get
 930             0 exch put
 931             hsR exch put
 932         } ifelse
 933         dup hsL 1 sub get /hsT exch def
 934         /hsJ hsL def
 935         {
 936             /hsS hsJ def
 937             /hsJ hsJ dup add def
 938             hsJ hsR gt { exit } if
 939             hsJ hsR lt {
 940                 dup dup hsJ 1 sub get Heapsort-cvi-or-cvr-or-cvs
 941                 exch hsJ get Heapsort-cvi-or-cvr-or-cvs
 942                 lt { /hsJ hsJ 1 add def } if
 943             } if
 944             dup hsJ 1 sub get Heapsort-cvi-or-cvr-or-cvs
 945             hsT Heapsort-cvi-or-cvr-or-cvs
 946             le { exit } if
 947             dup dup hsS 1 sub exch hsJ 1 sub get put
 948         } loop
 949         dup hsS 1 sub hsT put
 950     } loop
 951 } bind def
 952 "))
 953
 954 \f
 955 ;; EPSF document lay-out.
 956
 957 (defun ps-mode-epsf-sparse ()
 958   "Insert sparse EPSF template."
 959   (interactive)
 960   (goto-char (point-max))
 961   (unless (re-search-backward "%%EOF[ \t\n]*\\'" nil t)
 962     (goto-char (point-max))
 963     (insert "\n%%EOF\n"))
 964   (goto-char (point-max))
 965   (unless (re-search-backward "\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t)
 966     (re-search-backward "%%EOF")
 967     (insert "showpage\n"))
 968   (goto-char (point-max))
 969   (unless (re-search-backward "\\bend[ \t\n]+\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t)
 970     (re-search-backward "showpage")
 971     (insert "\nend\n"))
 972   (goto-char (point-min))
 973   (insert "%!PS-Adobe-3.0 EPSF-3.0\n%%BoundingBox: 0 0 ")
 974   (insert (format "%d %d\n\n"
 975                   (car ps-mode-paper-size)
 976                   (car (cdr ps-mode-paper-size))))
 977   (insert "64 dict begin\n\n"))
 978
 979 (defun ps-mode-epsf-rich ()
 980   "Insert rich EPSF template."
 981   (interactive)
 982   (ps-mode-epsf-sparse)
 983   (forward-line -3)
 984   (when buffer-file-name
 985     (insert "%%Title: " (file-name-nondirectory buffer-file-name) "\n"))
 986   (insert "%%Creator: " (user-full-name) "\n")
 987   (insert "%%CreationDate: " (current-time-string) "\n")
 988   (insert "%%EndComments\n")
 989   (forward-line 3))
 990
 991 \f
 992 ;; Interactive PostScript interpreter.
 993
 994 (defun ps-run-mode ()
 995   "Major mode in interactive PostScript window.
 996 This mode is invoked from ps-mode and should not be called directly.
 997
 998 \\{ps-run-mode-map}
 999 "
1000   (kill-all-local-variables)
1001   (make-local-variable 'font-lock-defaults)
1002   (setq font-lock-defaults '((ps-run-font-lock-keywords
1003                               ps-run-font-lock-keywords-1
1004                               ps-run-font-lock-keywords-2)
1005                              t)
1006         major-mode 'ps-run-mode
1007         mode-name  "Interactive PS"
1008         mode-line-process '(":%s"))
1009   (use-local-map ps-run-mode-map)
1010   (run-hooks 'ps-run-mode-hook))
1011
1012 (defun ps-run-running ()
1013   "Error if not in ps-mode or not running PostScript."
1014   (unless (equal major-mode 'ps-mode)
1015     (error "This function can only be called from PostScript mode"))
1016   (unless (equal (process-status "ps-run") 'run)
1017     (error "No PostScript process running")))
1018
1019 (defun ps-run-start ()
1020   "Start interactive PostScript."
1021   (interactive)
1022   (let ((command (if (and window-system ps-run-x) ps-run-x ps-run-dumb))
1023         (init-file nil)
1024         (process-connection-type nil)
1025         (oldwin (selected-window))
1026         i)
1027     (unless command
1028       (error "No command specified to run interactive PostScript"))
1029     (unless (and ps-run-mark (markerp ps-run-mark))
1030       (setq ps-run-mark (make-marker)))
1031     (when ps-run-init
1032       (setq init-file (ps-run-make-tmp-filename))
1033       (write-region (concat ps-run-init "\n") 0 init-file)
1034       (setq init-file (list init-file)))
1035     (pop-to-buffer "*ps run*")
1036     (ps-run-mode)
1037     (when (process-status "ps-run")
1038       (delete-process "ps-run"))
1039     (erase-buffer)
1040     (setq i (append command init-file))
1041     (while i
1042       (insert (car i) (if (cdr i) " " "\n"))
1043       (setq i (cdr i)))
1044     (eval (append '(start-process "ps-run" "*ps run*") command init-file))
1045     (select-window oldwin)))
1046
1047 (defun ps-run-quit ()
1048   "Quit interactive PostScript."
1049   (interactive)
1050   (ps-run-send-string "quit" t)
1051   (ps-run-cleanup))
1052
1053 (defun ps-run-kill ()
1054   "Kill interactive PostScript."
1055   (interactive)
1056   (delete-process "ps-run")
1057   (ps-run-cleanup))
1058
1059 (defun ps-run-clear ()
1060   "Clear/reset PostScript graphics."
1061   (interactive)
1062   (ps-run-send-string "showpage" t)
1063   (sit-for 1)
1064   (ps-run-send-string "" t))
1065
1066 (defun ps-run-buffer ()
1067   "Send buffer to PostScript interpreter."
1068   (interactive)
1069   (ps-run-region (point-min) (point-max)))
1070
1071 (defun ps-run-region (begin end)
1072   "Send region to PostScript interpreter."
1073   (interactive "r")
1074   (ps-run-running)
1075   (setq ps-run-parent (buffer-name))
1076   (let ((f (ps-run-make-tmp-filename)))
1077     (set-marker ps-run-mark begin)
1078     (write-region begin end f)
1079     (ps-run-send-string (format "(%s) run" f) t)))
1080
1081 (defun ps-run-boundingbox ()
1082   "View BoundingBox"
1083   (interactive)
1084   (ps-run-running)
1085   (let (x1 y1 x2 y2 f
1086            (buf (current-buffer)))
1087     (save-excursion
1088       (goto-char 1)
1089       (re-search-forward
1090        "^%%BoundingBox:[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)")
1091       (setq x1 (match-string 1)
1092             y1 (match-string 2)
1093             x2 (match-string 3)
1094             y2 (match-string 4)))
1095     (unless (< (string-to-number x1) (string-to-number x2))
1096       (error "x1 (%s) should be less than x2 (%s)" x1 x2))
1097     (unless (< (string-to-number y1) (string-to-number y2))
1098       (error "y1 (%s) should be less than y2 (%s)" y1 y2))
1099     (setq f (ps-run-make-tmp-filename))
1100     (write-region
1101      (format
1102       "gsave
1103     initgraphics
1104     2 setlinewidth
1105     %s %s moveto
1106     %s %s lineto
1107     %s %s lineto
1108     %s %s lineto
1109     closepath
1110     gsave
1111         [ 4 20 ] 0 setdash
1112         1 0 0 setrgbcolor
1113         stroke
1114     grestore
1115     gsave
1116         [ 4 20 ] 8 setdash
1117         0 1 0 setrgbcolor
1118         stroke
1119     grestore
1120     [ 4 20 ] 16 setdash
1121     0 0 1 setrgbcolor
1122     stroke
1123 grestore
1124 " x1 y1 x2 y1 x2 y2 x1 y2)
1125      0
1126      f)
1127     (ps-run-send-string (format "(%s) run" f) t)
1128     (set-buffer buf)))
1129
1130 (defun ps-run-send-string (string &optional echo)
1131   (let ((oldwin (selected-window)))
1132     (pop-to-buffer "*ps run*")
1133     (goto-char (point-max))
1134     (when echo
1135       (insert string "\n"))
1136     (set-marker (process-mark (get-process "ps-run")) (point))
1137     (process-send-string "ps-run" (concat string "\n"))
1138     (select-window oldwin)))
1139
1140 (defun ps-run-make-tmp-filename ()
1141   (unless ps-mode-tmp-file
1142     (cond (ps-run-tmp-dir)
1143           ((setq ps-run-tmp-dir (getenv "TEMP")))
1144           ((setq ps-run-tmp-dir (getenv "TMP")))
1145           ((setq ps-run-tmp-dir (getenv "HOME"))
1146            (setq
1147             ps-run-tmp-dir
1148             (concat (file-name-as-directory ps-run-tmp-dir) "tmp"))
1149            (unless (file-directory-p ps-run-tmp-dir)
1150              (setq ps-run-tmp-dir nil))))
1151     (unless ps-run-tmp-dir
1152       (setq ps-run-tmp-dir "/tmp"))
1153     (setq ps-mode-tmp-file
1154           (make-temp-name
1155            (concat
1156             (if ps-run-tmp-dir
1157                 (file-name-as-directory ps-run-tmp-dir)
1158               "")
1159             "ps-run-"))))
1160   ps-mode-tmp-file)
1161
1162 ;; Remove temporary file
1163 ;; This shouldn't fail twice, because it is called at kill-emacs
1164 (defun ps-run-cleanup ()
1165   (when ps-mode-tmp-file
1166     (let ((i ps-mode-tmp-file))
1167       (setq ps-mode-tmp-file nil)
1168       (when (file-exists-p i)
1169         (delete-file i)))))
1170
1171 (defun ps-run-mouse-goto-error (event)
1172   "Set point at mouse click, then call ps-run-goto-error."
1173   (interactive "e")
1174   (mouse-set-point event)
1175   (ps-run-goto-error))
1176
1177 (defun ps-run-newline ()
1178   "Process newline in PostScript interpreter window."
1179   (interactive)
1180   (end-of-line)
1181   (insert "\n")
1182   (forward-line -1)
1183   (when (looking-at ps-run-prompt)
1184     (goto-char (match-end 0)))
1185   (looking-at ".*")
1186   (goto-char (1+ (match-end 0)))
1187   (ps-run-send-string (buffer-substring (match-beginning 0) (match-end 0))))
1188
1189 (defun ps-run-goto-error ()
1190   "Jump to buffer position read as integer at point.
1191 Use line numbers if ps-run-error-line-numbers is not nil"
1192   (interactive)
1193   (let ((p (point)))
1194     (unless (looking-at "[0-9]")
1195       (goto-char (max 1 (1- (point)))))
1196     (when (looking-at "[0-9]")
1197       (forward-char 1)
1198       (forward-word -1)
1199       (when (looking-at "[0-9]+")
1200         (let (i)
1201           (setq
1202            i
1203            (string-to-int
1204             (buffer-substring (match-beginning 0) (match-end 0))))
1205           (goto-char p)
1206           (pop-to-buffer ps-run-parent)
1207           (if ps-run-error-line-numbers
1208               (progn
1209                 (goto-char (marker-position ps-run-mark))
1210                 (forward-line (1- i))
1211                 (end-of-line))
1212             (goto-char (+ i (marker-position ps-run-mark)))))))))
1213
1214 \f
1215 ;;
1216 (add-hook 'kill-emacs-hook 'ps-run-cleanup)
1217
1218 (provide 'ps-mode)
1219
1220 ;;; ps-mode.el ends here