lisp/progmodes/ps-mode.el

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