;;; ps-mode.el --- PostScript mode for GNU Emacs.

;; Author: Peter Kleiweg <p.c.j.kleiweg@rug.nl>
;; Created: 20 Aug 1997
;; Version: ps-mode.el, v1.0d 1998/12/19
;; Keywords: PostScript, languages

;; LCD Archive Entry:
;; ps-mode|Peter Kleiweg|p.c.j.kleiweg@rug.nl|
;; PostScript mode for GNU Emacs|
;; 1998/12/19|1.0d|~/modes/ps-mode.el.Z|

;;; Commentary:

;; A major mode for editing PostScript

;; Requires: easymenu, hilit19

;;; Code:

(if window-system
  (require 'hilit19))
(require 'easymenu)

;; user options

(defvar ps-tab 4
  "User option: number of spaces to use when indenting.")

(defvar ps-auto-indent t
  "User option: t means use autoindent.")

(defvar ps-paper-size '(595 842)
  "User option: default paper size.

When inserting an EPSF template the values of ps-paper-size are used
to set the boundingbox to include the whole page.
When the figure is finished these values should be replaced.

Some often used papersizes are listed below.

  a4:     595  842
  legal:  612 1008
  letter: 612  792
  note:   540  720
")

(defvar ps-run-tmp-dir nil
  "User option: name of directory to place temporary file.

If nil, the following are tried in turn, until success:
  1. \"$TEMP\"
  2. \"$TMP\"
  3. \"$HOME/tmp\"
  4. \"/tmp\"
")

(defvar ps-run-prompt "\\(GS\\(<[0-9]+\\)?>\\)+"
  "User option: regexp to match prompt in interactive PostScript.")

(defvar ps-run-x '("gs" "-r72" "-sPAPERSIZE=a4")
  "User option: command as list to run PostScript with graphic display.")

(defvar ps-run-dumb '("gs" "-dNODISPLAY")
  "User option: command as list to run PostScript without graphic display.")

(defvar ps-run-init nil
  "User option: string of commands to send to PostScript to start interactive.

Example: \"executive\\n\"

You won't need this option for Ghostscript.
")

(defvar ps-run-error-line-numbers nil
  "User option: t means: error messages contain line numbers.
  nil means: error messages contain byte counts.")

(defvar ps-print-function 'lpr-buffer
  "User option: name of Lisp function to print current buffer as PostScript.
This function will be used to print regions as well.

Example:

  (setq
    ps-print-function
    '(lambda ()
       (let (
           (lpr-switches nil)
           (lpr-command \"lpr\"))
         (lpr-buffer))))
")

;;

(defvar ps-mode-map nil
  "Local keymap to use in ps-mode.")

(defvar ps-mode-syntax-table nil
  "Syntax table used while in ps-mode.")

(defvar ps-run-mode-map nil
  "Local keymap to use in ps-run-mode.")

(defvar ps-tmp-file nil
  "Name of temporary file, set by ps-run.")

(defvar ps-run-mark nil
  "Mark to start of region sent to PostScript.")

(defvar ps-run-parent nil
  "Parent window of interactive PostScript.")

;;

;;;###autoload
(defun ps-mode ()
  "Major mode for editing PostScript with GNU Emacs.

Entry to this mode calls `ps-mode-hook'.

Things to add to your .emacs file:

  (autoload 'ps-mode \"ps-mode\" \"Major mode for editing PostScript\" t)
  (setq auto-mode-alist
    (append
      '((\"\\\\.ps$\"   . ps-mode)
        (\"\\\\.eps$\"  . ps-mode)
        (\"\\\\.epsf$\" . ps-mode))
      auto-mode-alist))

The following variables hold user options, and could be
given other values from within your .emacs file:

  ps-auto-indent
  ps-tab
  ps-paper-size
  ps-run-tmp-dir
  ps-run-prompt
  ps-run-x
  ps-run-dumb
  ps-run-init
  ps-run-error-line-numbers
  ps-print-function

Type \\[describe-variable] for documentation on these options.

\\{ps-mode-map}

When starting an interactive PostScript process with \\[ps-run-start],
a second window will be displayed, and `ps-run-mode-hook' will be called.
The keymap for this second window is:

\\{ps-run-mode-map}

When Ghostscript encounters an error it displays an error message
with a file position. Clicking mouse-2 on this number will bring
point to the corresponding spot in the PostScript window, if input
to the interpreter was sent from that window.
Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect.
"
  (interactive)
  (setq major-mode 'ps-mode
        mode-name  "PostScript")
  (use-local-map ps-mode-map)
  (set-syntax-table ps-mode-syntax-table)
  (run-hooks 'ps-mode-hook))

;; key-handlers

(defun ps-newline ()
  "Insert newline, indent if after begin group."
  (interactive)
  (if (not ps-auto-indent)
    (insert "\n")
    (progn
      (let
        ( (here (point))
          pos
        )
        (if (re-search-backward "\\({\\|\\[\\|<<\\)\\=" (- here 2) t)
          (progn
            (beginning-of-line)
            (looking-at "[ \t]*")
            (goto-char (match-end 0))
            (setq pos (current-column))
            (goto-char here)
            (insert
              "\n"
              (make-string (/ (+ pos ps-tab) tab-width) ?\t)
              (make-string (mod (+ pos ps-tab) tab-width) ?\ )))
          (progn
            (goto-char here)
            (insert "\n")
            ; copy leading whitespace from previous line
            (setq here (point))
            (forward-line -1)
            (looking-at "[ \t]*")
            (forward-line 1)
            (insert (buffer-substring (match-beginning 0) (match-end 0))))))
      ; remove trailing whitespace previous line
      (save-excursion
        (forward-line -1)
        (beginning-of-line)
        (if (looking-at "[ \t]*$")
          (replace-match "")
          (if (looking-at "\\(.*[^ \t\n]\\)[ \t]+$")
            (replace-match "\\1"))))
      (if (looking-at "[ \t]+")
        (replace-match "")))))

(defun ps-r-brace ()
  "INSERT `}' and perform balance."
  (interactive)
  (insert "}")
  (ps-r-balance "{" "}"))

(defun ps-r-angle ()
  "Insert `]' and perform balance."
  (interactive)
  (insert "]")
  (ps-r-balance "[" "]"))

(defun ps-r-gt ()
  "Insert `>' and perform balance."
  (interactive)
  (insert ">")
  (ps-r-balance "<<" ">>"))

(defun ps-r-balance (left right)
  "Put RIGHT below start of line matching LEFT if only leading whitespace."
  (if ps-auto-indent
    (save-excursion
      (let
        ( (here (point))
          (len (length right))
          begin
          end
        )
        (setq end (- here len))
        (beginning-of-line)
        (if (looking-at (concat "[ \t]*" (regexp-quote right)))
          (if (= (match-end 0) here)
            (progn
              (goto-char here)
              (backward-sexp 1)
              (setq begin (point))
              (if (looking-at (regexp-quote left))
                (progn
                  (beginning-of-line)
                  (looking-at "[ \t]*")
                  (goto-char end)
                  (beginning-of-line)
                  (insert (buffer-substring (match-beginning 0) (match-end 0)))
                  (looking-at "[ \t]*")
                  (replace-match "")))))))))
  (blink-matching-open))

(defun ps-other-newline ()
  "Perform newline in *ps run* buffer"
  (interactive)
  (let ((buf (current-buffer)))
    (set-buffer "*ps run*")
    (ps-run-newline)
    (set-buffer buf)))

;; print PostScript

(defun ps-print-buffer ()
  "Print buffer as PostScript"
  (interactive)
  (eval (list ps-print-function)))

(defun ps-print-region (begin end)
  "Print region as PostScript, %!PS prepended, showpage appended"
  (interactive "r")
  (let ((oldbuf (current-buffer))
        (tmpbuf (get-buffer-create "*ps print*")))
    (copy-to-buffer tmpbuf begin end)
    (set-buffer tmpbuf)
    (goto-char 1)
    (insert "%!PS\n")
    (goto-char (point-max))
    (insert "\nshowpage\n")
    (eval (list ps-print-function))
    (set-buffer oldbuf)
    (kill-buffer tmpbuf)))

;; convert 8-bit to octal codes

(defun ps-octal-buffer ()
  "Change 8-bit characters to octal codes in buffer."
  (interactive)
  (ps-octal-region (point-min) (point-max)))

(defun ps-octal-region (begin end)
  "Change 8-bit characters to octal codes in region."
  (interactive "r")
  (if buffer-read-only
    (progn
      (ding)
      (message "Buffer is read only"))
    (save-excursion
      (let (endm i)
        (setq endm (make-marker))
        (set-marker endm end)
        (goto-char begin)
        (setq i 0)
        (while (re-search-forward "[\200-\377]" (marker-position endm) t)
          (setq i (1+ i))
          (backward-char)
          (insert (format "\\%03o" (string-to-char (buffer-substring (point) (1+ (point))))))
          (delete-char 1))
        (message (format "%d change%s made" i (if (= i 1) "" "s")))
        (setq endm nil)))))

;; cookbook

(defun ps-center ()
  "Insert /center."
  (interactive)
  (insert "/center {
    dup stringwidth pop
    2 div neg 0 rmoveto
} bind def

"))

(defun ps-right ()
  "Insert /right."
  (interactive)
  (insert "/right {
    dup stringwidth pop
    neg 0 rmoveto
} bind def

"))

(defun ps-RE ()
  "Insert /RE."
  (interactive)
  (insert "% `new-font-name' `encoding-vector' `old-font-name' RE -
/RE {
    findfont
    dup maxlength dict begin {
        1 index /FID ne { def } { pop pop } ifelse
    } forall
    /Encoding exch def
    dup /FontName exch def
    currentdict end definefont pop
} bind def

"))

(defun ps-latin-extended ()
  "Insert /ISOLatin1Extended

This encoding vector contains all the entries from ISOLatin1Encoding
plus the usually uncoded characters inserted on positions 1 through 28.
"
  (interactive)
  (insert "% ISOLatin1Encoding, extended with remaining uncoded glyphs
/ISOLatin1Extended [
    /.notdef /Lslash /lslash /OE /oe /Scaron /scaron /Zcaron /zcaron
    /Ydieresis /trademark /bullet /dagger /daggerdbl /ellipsis /emdash
    /endash /fi /fl /florin /fraction /guilsinglleft /guilsinglright
    /perthousand /quotedblbase /quotedblleft /quotedblright
    /quotesinglbase /quotesingle /.notdef /.notdef /.notdef /space
    /exclam /quotedbl /numbersign /dollar /percent /ampersand
    /quoteright /parenleft /parenright /asterisk /plus /comma /minus
    /period /slash /zero /one /two /three /four /five /six /seven /eight
    /nine /colon /semicolon /less /equal /greater /question /at /A /B /C
    /D /E /F /G /H /I /J /K /L /M /N /O /P /Q /R /S /T /U /V /W /X /Y /Z
    /bracketleft /backslash /bracketright /asciicircum /underscore
    /quoteleft /a /b /c /d /e /f /g /h /i /j /k /l /m /n /o /p /q /r /s
    /t /u /v /w /x /y /z /braceleft /bar /braceright /asciitilde
    /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
    /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
    /.notdef /.notdef /.notdef /dotlessi /grave /acute /circumflex
    /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla
    /.notdef /hungarumlaut /ogonek /caron /space /exclamdown /cent
    /sterling /currency /yen /brokenbar /section /dieresis /copyright
    /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron
    /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
    /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright
    /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute
    /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute
    /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth
    /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
    /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn
    /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring
    /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave
    /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute
    /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute
    /ucircumflex /udieresis /yacute /thorn /ydieresis
] def

"))

(defun ps-heapsort ()
  "Insert /Heapsort."
  (interactive)
  (insert "% `array-element' Heapsort-cvi-or-cvr-or-cvs `number-or-string'
/Heapsort-cvi-or-cvr-or-cvs {
    % 0 get
} bind def
% `array' Heapsort `sorted-array'
/Heapsort {
    dup length /hsR exch def
    /hsL hsR 2 idiv 1 add def
    {
        hsR 2 lt { exit } if
        hsL 1 gt {
            /hsL hsL 1 sub def
        } {
            /hsR hsR 1 sub def
            dup dup dup 0 get exch dup hsR get
            0 exch put
            hsR exch put
        } ifelse
        dup hsL 1 sub get /hsT exch def
        /hsJ hsL def
        {
            /hsS hsJ def
            /hsJ hsJ dup add def
            hsJ hsR gt { exit } if
            hsJ hsR lt {
                dup dup hsJ 1 sub get Heapsort-cvi-or-cvr-or-cvs
                exch hsJ get Heapsort-cvi-or-cvr-or-cvs
                lt { /hsJ hsJ 1 add def } if
            } if
            dup hsJ 1 sub get Heapsort-cvi-or-cvr-or-cvs
            hsT Heapsort-cvi-or-cvr-or-cvs
            le { exit } if
            dup dup hsS 1 sub exch hsJ 1 sub get put
        } loop
        dup hsS 1 sub hsT put
    } loop
} bind def

"))

;; epsf document lay-out

(defun ps-epsf-sparse ()
  "Insert sparse EPSF template."
  (interactive)
  (goto-char (point-max))
  (if (not (re-search-backward "%%EOF[ \t\n]*\\'" nil t))
    (progn
      (goto-char (point-max))
      (insert "\n%%EOF\n")))
  (goto-char (point-max))
  (if (not (re-search-backward "\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t))
    (progn
      (re-search-backward "%%EOF")
      (insert "showpage\n")))
  (goto-char (point-max))
  (if (not (re-search-backward "\\bend[ \t\n]+\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t))
    (progn
      (re-search-backward "showpage")
      (insert "\nend\n")))
  (goto-char (point-min))
  (insert "%!PS-Adobe-3.0 EPSF-3.0\n%%BoundingBox: 0 0 ")
  (insert (format "%d %d\n\n" (car ps-paper-size) (car (cdr ps-paper-size))))
  (insert "64 dict begin\n\n"))

(defun ps-epsf-rich ()
  "Insert rich EPSF template."
  (interactive)
  (ps-epsf-sparse)
  (forward-line -3)
  (if buffer-file-name
    (insert "%%Title: " (file-name-nondirectory buffer-file-name) "\n"))
  (insert "%%Creator: " (user-full-name) "\n")
  (insert "%%CreationDate: " (current-time-string) "\n")
  (insert "%%EndComments\n")
  (forward-line 3)
)

;; Interactive PostScript interpreter

(defun ps-run-running ()
  "Error if not in ps-mode or not running PostScript."
  (if (not (equal major-mode 'ps-mode))
    (error "This function can only be called from PostScript mode"))
  (if (not (equal (process-status "ps-run") 'run))
    (error "No PostScript process running")))

(defun ps-run-start ()
  "Start interactive PostScript."
  (interactive)
  (let
    ( (command (if (and window-system ps-run-x) ps-run-x ps-run-dumb))
      (init-file nil)
      (process-connection-type nil)
      (oldbuf (current-buffer))
      (oldwin (selected-window))
      i
    )
    (if (not command)
      (error "No command specified to run interactive PostScript"))
    (if (or (not ps-run-mark) (not (markerp ps-run-mark)))
      (setq ps-run-mark (make-marker)))
    (if ps-run-init
      (progn
        (setq init-file (ps-run-make-tmp-filename))
        (write-region ps-run-init 0 init-file)
        (setq init-file (list init-file))))
    (pop-to-buffer "*ps run*")
    (ps-run-mode)
    (if (process-status "ps-run")
      (delete-process "ps-run"))
    (erase-buffer)
    (setq i (append command init-file))
    (while i
      (insert (car i) (if (cdr i) " " "\n"))
      (setq i (cdr i)))
    (eval (append '(start-process "ps-run" "*ps run*") command init-file))
    (select-window oldwin)))

(defun ps-run-quit ()
  "Quit interactive PostScript."
  (interactive)
  (ps-run-send-string "quit" t)
  (ps-run-cleanup))

(defun ps-run-kill ()
  "Kill interactive PostScript."
  (interactive)
  (delete-process "ps-run")
  (ps-run-cleanup))

(defun ps-run-clear ()
  "Clear/reset PostScript graphics."
  (interactive)
  (ps-run-send-string "showpage" t)
  (sit-for 1)
  (ps-run-send-string "" t))

(defun ps-run-buffer ()
  "Send buffer to PostScript interpreter."
  (interactive)
  (ps-run-region (point-min) (point-max)))

(defun ps-run-region (begin end)
  "Send region to PostScript interpreter."
  (interactive "r")
  (ps-run-running)
  (setq ps-run-parent (buffer-name))
  (let ((f (ps-run-make-tmp-filename)))
    (set-marker ps-run-mark begin)
    (write-region begin end f)
    (ps-run-send-string (format "(%s) run" f) t)))

(defun ps-run-boundingbox ()
  "View BoundingBox"
  (interactive)
  (ps-run-running)
  (let (
      x1 y1 x2 y2 f
      (buf (current-buffer))
    )
    (save-excursion
      (goto-char 1)
      (re-search-forward
          "^%%BoundingBox:[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)")
      (setq x1 (buffer-substring (match-beginning 1) (match-end 1)))
      (setq y1 (buffer-substring (match-beginning 2) (match-end 2)))
      (setq x2 (buffer-substring (match-beginning 3) (match-end 3)))
      (setq y2 (buffer-substring (match-beginning 4) (match-end 4))))
    (if (not (< (string-to-number x1) (string-to-number x2)))
      (error "x1 (%s) should be less than x2 (%s)" x1 x2))
    (if (not (< (string-to-number y1) (string-to-number y2)))
      (error "y1 (%s) should be less than y2 (%s)" y1 y2))
    (setq f (ps-run-make-tmp-filename))
    (write-region
      (format
"gsave
    initgraphics
    2 setlinewidth
    %s %s moveto
    %s %s lineto
    %s %s lineto
    %s %s lineto
    closepath
    gsave
        [ 4 20 ] 0 setdash
        1 0 0 setrgbcolor
        stroke
    grestore
    gsave
        [ 4 20 ] 8 setdash
        0 1 0 setrgbcolor
        stroke
    grestore
    [ 4 20 ] 16 setdash
    0 0 1 setrgbcolor
    stroke
grestore
" x1 y1 x2 y1 x2 y2 x1 y2)
      0
      f)
    (ps-run-send-string (format "(%s) run" f) t)
    (set-buffer buf)))

(defun ps-run-send-string (string &optional echo)
  (let ((oldwin (selected-window)))
    (pop-to-buffer "*ps run*")
    (goto-char (point-max))
    (if echo
      (insert string "\n"))
    (set-marker (process-mark (get-process "ps-run")) (point))
    (process-send-string "ps-run" (concat string "\n"))
    (select-window oldwin)))

;

(defun ps-run-make-tmp-filename ()
  (if (not ps-tmp-file)
    (progn
      (if (not ps-run-tmp-dir)
        (if (not (setq ps-run-tmp-dir (getenv "TEMP")))
          (if (not (setq ps-run-tmp-dir (getenv "TMP")))
            (if (setq ps-run-tmp-dir (getenv "HOME"))
              (progn
                (setq
                  ps-run-tmp-dir
                  (concat (file-name-as-directory ps-run-tmp-dir) "tmp"))
                (if (not (file-directory-p ps-run-tmp-dir))
                  (setq ps-run-tmp-dir nil)))))))
      (if (not ps-run-tmp-dir)
        (setq ps-run-tmp-dir "/tmp"))
      (setq
        ps-tmp-file
        (make-temp-name
          (concat
            (if ps-run-tmp-dir
              (file-name-as-directory ps-run-tmp-dir)
              "")
            "ps-run")))))
  ps-tmp-file)

; Remove temporary file
; This shouldn't fail twice, because it is called at kill-emacs
(defun ps-run-cleanup ()
  (if ps-tmp-file
    (let ((i ps-tmp-file))
      (setq ps-tmp-file nil)
      (if (file-exists-p i)
        (delete-file i)))))
;

(defun ps-run-mode ()
  "Major mode in interactive PostScript window.
This mode is invoked from ps-mode and should not be called directly.

\\{ps-run-mode-map}
"
  (setq major-mode 'ps-run-mode
        mode-name  "Interactive PS"
        mode-line-process '(":%s"))
  (use-local-map ps-run-mode-map)
  (run-hooks 'ps-run-mode-hook))

(defun ps-run-mouse-goto-error (event)
  "Set point at mouse click, then call ps-run-goto-error."
  (interactive "e")
  (mouse-set-point event)
  (ps-run-goto-error))

(defun ps-run-newline ()
  "Process newline in PostScript interpreter window."
  (interactive)
  (end-of-line)
  (insert "\n")
  (forward-line -1)
  (if (looking-at ps-run-prompt)
    (goto-char (match-end 0)))
  (looking-at ".*")
  (goto-char (1+ (match-end 0)))
  (ps-run-send-string (buffer-substring (match-beginning 0) (match-end 0))))

(defun ps-run-goto-error ()
  "Jump to buffer position read as integer at point.
Use line numbers if ps-run-error-line-numbers is not nil"
  (interactive)
  (let ((p (point)))
    (if (not (looking-at "[0-9]"))
      (goto-char (max 1 (1- (point)))))
    (if (looking-at "[0-9]")
      (progn
        (forward-char 1)
        (forward-word -1)
        (if (looking-at "[0-9]+")
          (let (i)
            (setq
              i
              (string-to-int
                (buffer-substring (match-beginning 0) (match-end 0))))
            (goto-char p)
            (pop-to-buffer ps-run-parent)
            (if ps-run-error-line-numbers
              (progn
                (goto-char (marker-position ps-run-mark))
                (forward-line (1- i)))
              (goto-char (+ i (marker-position ps-run-mark))))))))))

;; highlighting

(if window-system
  (hilit-set-mode-patterns
   'ps-mode
   '(("\\`%!.*$" nil define)
     ("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+"
      nil define)
     ("%.*$" nil comment)
     ("<<\\|>>" nil defun)
     ("(\\(\\\\)\\|[^)]\\)*)" nil string)
     ("<[ \t\n0-9a-fA-F]*>" nil string)
     ("<~" "~>" string)
     ("^/[^][ \t\n{}()<>/]*" nil defun)
  ;   ("/[^][ \t\n{}()<>/]*" nil decl)
     ("\\b\\(bind\\|def\\|dict\\|begin\\|end\\|mark\\)\\b" nil keyword)
     ("\\bshowpage\\b" nil keyword)
     ("\\b\\(exec\\|exit\\|if\\|ifelse\\|for\\|forall\\|repeat\\|loop\\)\\b"
      nil keyword)
     ("\\b\\(stop\\|stopped\\|quit\\|start\\)\\b" nil keyword)
     ("\\b\\(gsave\\|grestore\\|save\\|restore\\)\\b" nil keyword)
     ("\\b\\(null\\|true\\|false\\)\\b" nil keyword)
     )))

;; mouse menu

(defconst ps-mode-menu-main
  '("PostScript"
    ["EPSF template, sparse" ps-epsf-sparse t]
    ["EPSF template, rich"   ps-epsf-rich t]
    "---"
    ("Cookbook"
     ["RE" ps-RE t]
     ["ISOLatin1Extended" ps-latin-extended t]
     ["center" ps-center t]
     ["right" ps-right t]
     ["Heapsort" ps-heapsort t])
    ("Fonts (1)"
     ["Times-Roman" (insert "/Times-Roman ") t]
     ["Times-Bold" (insert "/Times-Bold ") t]
     ["Times-Italic" (insert "/Times-Italic ") t]
     ["Times-BoldItalic" (insert "/Times-BoldItalic ") t]
     ["Helvetica" (insert "/Helvetica ") t]
     ["Helvetica-Bold" (insert "/Helvetica-Bold ") t]
     ["Helvetica-Oblique" (insert "/Helvetica-Oblique ") t]
     ["Helvetica-BoldOblique" (insert "/Helvetica-BoldOblique ") t]
     ["Courier" (insert "/Courier ") t]
     ["Courier-Bold" (insert "/Courier-Bold ") t]
     ["Courier-Oblique" (insert "/Courier-Oblique ") t]
     ["Courier-BoldOblique" (insert "/Courier-BoldOblique ") t]
     ["Symbol" (insert "/Symbol") t ])
    ("Fonts (2)"
     ["AvantGarde-Book" (insert "/AvantGarde-Book ") t]
     ["AvantGarde-Demi" (insert "/AvantGarde-Demi ") t]
     ["AvantGarde-BookOblique" (insert "/AvantGarde-BookOblique ") t]
     ["AvantGarde-DemiOblique" (insert "/AvantGarde-DemiOblique ") t]
     ["Bookman-Light" (insert "/Bookman-Light ") t]
     ["Bookman-Demi" (insert "/Bookman-Demi ") t]
     ["Bookman-LightItalic" (insert "/Bookman-LightItalic ") t]
     ["Bookman-DemiItalic" (insert "/Bookman-DemiItalic ") t]
     ["Helvetica-Narrow" (insert "/Helvetica-Narrow ") t]
     ["Helvetica-Narrow-Bold" (insert "/Helvetica-Narrow-Bold ") t]
     ["Helvetica-Narrow-Oblique" (insert "/Helvetica-Narrow-Oblique ") t]
     ["Helvetica-Narrow-BoldOblique" (insert "/Helvetica-Narrow-BoldOblique ") t]
     ["NewCenturySchlbk-Roman" (insert "/NewCenturySchlbk-Roman ") t]
     ["NewCenturySchlbk-Bold" (insert "/NewCenturySchlbk-Bold ") t]
     ["NewCenturySchlbk-Italic" (insert "/NewCenturySchlbk-Italic ") t]
     ["NewCenturySchlbk-BoldItalic" (insert "/NewCenturySchlbk-BoldItalic ") t]
     ["Palatino-Roman" (insert "/Palatino-Roman ") t]
     ["Palatino-Bold" (insert "/Palatino-Bold ") t]
     ["Palatino-Italic" (insert "/Palatino-Italic ") t]
     ["Palatino-BoldItalic" (insert "/Palatino-BoldItalic ") t]
     ["ZapfChancery-MediumItalic" (insert "/ZapfChancery-MediumItalic ") t]
     ["ZapfDingbats" (insert "/ZapfDingbats ") t])
    "---"
    ["8-bit to octal buffer" ps-octal-buffer t]
    ["8-bit to octal region" ps-octal-region (mark t)]
    "---"
    ("Auto indent"
     ["On" (setq ps-auto-indent t) (not ps-auto-indent)]
     ["Off" (setq ps-auto-indent nil) ps-auto-indent])
    "---"
    ["Start PostScript"
     ps-run-start
     (not (equal (process-status "ps-run") 'run))]
    ["Quit PostScript" ps-run-quit (process-status "ps-run")]
    ["Kill PostScript" ps-run-kill (process-status "ps-run")]
    ["Send buffer to interpreter"
     ps-run-buffer
     (process-status "ps-run")]
    ["Send region to interpreter"
     ps-run-region
     (and (mark t) (process-status "ps-run"))]
    ["View BoundingBox"
     ps-run-boundingbox
     (process-status "ps-run")]
    ["Clear/Reset PostScript graphics"
     ps-run-clear
     (process-status "ps-run")]
    "---"
    ["Print buffer as PostScript"
     ps-print-buffer
     t]
    ["Print region as PostScript"
     ps-print-region
     (mark t)]))

;; keys

(if (not ps-mode-syntax-table)
  (progn
     (setq ps-mode-syntax-table (make-syntax-table))
     (modify-syntax-entry ?\" "w " ps-mode-syntax-table)
     (modify-syntax-entry ?\% "< " ps-mode-syntax-table)
     (modify-syntax-entry ?\n "> " ps-mode-syntax-table)
     (modify-syntax-entry ?\r "> " ps-mode-syntax-table)
     (modify-syntax-entry ?\f "> " ps-mode-syntax-table)
     (modify-syntax-entry ?\< "(>" ps-mode-syntax-table)
     (modify-syntax-entry ?\> ")<" ps-mode-syntax-table)))

(if ps-mode-map nil
  (progn
    (setq ps-mode-map (make-sparse-keymap))
    (define-key ps-mode-map [return] 'ps-newline)
    (define-key ps-mode-map "\177" 'backward-delete-char-untabify)
    (define-key ps-mode-map "\r" 'ps-newline)
    (define-key ps-mode-map "}" 'ps-r-brace)
    (define-key ps-mode-map "]" 'ps-r-angle)
    (define-key ps-mode-map ">" 'ps-r-gt)
    (define-key ps-mode-map "\C-c\C-j" 'ps-other-newline)
    (define-key ps-mode-map "\C-c\C-t" 'ps-epsf-rich)
    (define-key ps-mode-map "\C-c\C-s" 'ps-run-start)
    (define-key ps-mode-map "\C-c\C-q" 'ps-run-quit)
    (define-key ps-mode-map "\C-c\C-k" 'ps-run-kill)
    (define-key ps-mode-map "\C-c\C-b" 'ps-run-buffer)
    (define-key ps-mode-map "\C-c\C-r" 'ps-run-region)
    (define-key ps-mode-map "\C-c\C-v" 'ps-run-boundingbox)
    (define-key ps-mode-map "\C-c\C-c" 'ps-run-clear)
    (define-key ps-mode-map "\C-c\C-p" 'ps-print-buffer)
    (easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main)))

(if ps-run-mode-map nil
  (progn
    (setq ps-run-mode-map (make-sparse-keymap))
    (define-key ps-run-mode-map [return] 'ps-run-newline)
    (define-key ps-run-mode-map "\r" 'ps-run-newline)
    (define-key ps-run-mode-map "\C-c\C-q" 'ps-run-quit)
    (define-key ps-run-mode-map "\C-c\C-k" 'ps-run-kill)
    (define-key ps-run-mode-map "\C-c\C-e" 'ps-run-goto-error)
    (define-key ps-run-mode-map [mouse-2] 'ps-run-mouse-goto-error)))

(add-hook 'kill-emacs-hook 'ps-run-cleanup)

(provide 'ps-mode)

;;; ps-mode.el ends here