Mercurial > emacs
diff lisp/progmodes/ps-mode.el @ 25990:2b2b161bac67
New file. Major mode for editing PostScript.
| author | Gerd Moellmann <gerd@gnu.org> |
|---|---|
| date | Tue, 12 Oct 1999 14:55:35 +0000 |
| parents | |
| children | 6b9477637c7c |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/progmodes/ps-mode.el Tue Oct 12 14:55:35 1999 +0000 @@ -0,0 +1,1177 @@ +;;; ps-mode.el --- PostScript mode for GNU Emacs. + +;; Copyright (C) 1999 Free Software Foundation, Inc. + +;; Author: Peter Kleiweg <kleiweg@let.rug.nl> +;; Maintainer: Peter Kleiweg <kleiweg@let.rug.nl> +;; Created: 20 Aug 1997 +;; Version: 1.1a, 11 Oct 1999 +;; Keywords: PostScript, languages + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + + +;;; Code: + +(require 'easymenu) + +;; Define core `PostScript' group. +(defgroup PostScript nil + "PostScript mode for Emacs." + :group 'languages) + +(defgroup PostScript-edit nil + "PostScript editing." + :prefix "ps-mode-" + :group 'PostScript) + +(defgroup PostScript-interaction nil + "PostScript interaction." + :prefix "ps-run-" + :group 'PostScript) + +;; User variables. + +(defcustom ps-mode-auto-indent t + "*Should we use autoindent?" + :group 'PostScript-edit + :type 'boolean) + +(defcustom ps-mode-tab 4 + "*Number of spaces to use when indenting." + :group 'PostScript-edit + :type 'integer) + +(defcustom ps-mode-paper-size '(595 842) + "*Default paper size. + +When inserting an EPSF template these values are used +to set the boundingbox to include the whole page. +When the figure is finished these values should be replaced." + :group 'PostScript-edit + :type '(choice + (const :tag "letter" (612 792)) + (const :tag "legal" (612 1008)) + (const :tag "a0" (2380 3368)) + (const :tag "a1" (1684 2380)) + (const :tag "a2" (1190 1684)) + (const :tag "a3" (842 1190)) + (const :tag "a4" (595 842)) + (const :tag "a5" (421 595)) + (const :tag "a6" (297 421)) + (const :tag "a7" (210 297)) + (const :tag "a8" (148 210)) + (const :tag "a9" (105 148)) + (const :tag "a10" (74 105)) + (const :tag "b0" (2836 4008)) + (const :tag "b1" (2004 2836)) + (const :tag "b2" (1418 2004)) + (const :tag "b3" (1002 1418)) + (const :tag "b4" (709 1002)) + (const :tag "b5" (501 709)) + (const :tag "archE" (2592 3456)) + (const :tag "archD" (1728 2592)) + (const :tag "archC" (1296 1728)) + (const :tag "archB" (864 1296)) + (const :tag "archA" (648 864)) + (const :tag "flsa" (612 936)) + (const :tag "flse" (612 936)) + (const :tag "halfletter" (396 612)) + (const :tag "11x17" (792 1224)) + (const :tag "tabloid" (792 1224)) + (const :tag "ledger" (1224 792)) + (const :tag "csheet" (1224 1584)) + (const :tag "dsheet" (1584 2448)) + (const :tag "esheet" (2448 3168)))) + +(defcustom ps-mode-print-function '(lambda () + (let ((lpr-switches nil) + (lpr-command \"lpr\")) + (lpr-buffer))) + "*Lisp function to print current buffer as PostScript." + :group 'PostScript-edit + :type 'function) + +(defcustom ps-run-prompt "\\(GS\\(<[0-9]+\\)?>\\)+" + "*Regexp to match prompt in interactive PostScript." + :group 'PostScript-interaction + :type 'regexp) + +(defcustom ps-run-messages + '((">>showpage, press <return> to continue<<" + (0 font-lock-keyword-face nil nil)) + ("^\\(Error\\|Can't\\).*" + (0 font-lock-warning-face nil nil)) + ("^\\(Current file position is\\) \\([0-9]+\\)" + (1 font-lock-comment-face nil nil) + (2 font-lock-warning-face nil nil))) + "*Medium level highlighting of messages from the PostScript interpreter. + +See documentation on font-lock for details." + :group 'PostScript-interaction + :type '(repeat (list :tag "Expression with one or more highlighters" + :value ("" (0 default nil t)) + (regexp :tag "Expression") + (repeat :tag "Highlighters" + :inline regexp + (list :tag "Highlighter" + (integer :tag "Subexp") + face + (boolean :tag "Override") + (boolean :tag "Laxmatch" :value t)))))) + +(defcustom ps-run-x '("gs" "-r72" "-sPAPERSIZE=a4") + "*Command as list to run PostScript with graphic display." + :group 'PostScript-interaction + :type '(repeat string)) + +(defcustom ps-run-dumb '("gs" "-dNODISPLAY") + "*Command as list to run PostScript without graphic display." + :group 'PostScript-interaction + :type '(repeat string)) + +(defcustom ps-run-init nil + "*String of commands to send to PostScript to start interactive. + +Example: \"executive\\n\" + +You won't need to set this option for Ghostscript. +" + :group 'PostScript-interaction + :type '(choice (const nil) string)) + +(defcustom ps-run-error-line-numbers nil + "*What values are used by the PostScript interpreter in error messages?" + :group 'PostScript-interaction + :type '(choice (const :tag "line numbers" t) + (const :tag "byte counts" nil))) + +(defcustom ps-run-tmp-dir nil + "*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\" +" + :group 'PostScript-interaction + :type '(choice (const nil) directory)) + + +;; Constants used for font-lock. + +;; Only a small set of the PostScript operators is selected for fontification. +;; Fontification is meant to clarify the document structure and process flow, +;; fontifying all known PostScript operators would hinder that objective. +(defconst ps-mode-operators + (let ((ops '("clear" "mark" "cleartomark" "counttomark" + "forall" + "dict" "begin" "end" "def" + "true" "false" + "exec" "if" "ifelse" "for" "repeat" "loop" "exit" + "stop" "stopped" "countexecstack" "execstack" + "quit" "start" + "save" "restore" + "bind" "null" + "gsave" "grestore" "grestoreall" + "showpage"))) + (concat "\\<" (regexp-opt ops t) "\\>")) + "Regexp of PostScript operators that will be fontified") + +;; Level 1 font-lock: +;; - Special comments (reference face) +;; - Strings and other comments +;; - Partial strings (warning face) +;; - 8bit characters (warning face) +;; Multiline strings are not supported. Strings with nested brackets are. +(defconst ps-mode-font-lock-keywords-1 + '(("\\`%!PS.*" . font-lock-reference-face) + ("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$" + . font-lock-reference-face) + (ps-mode-match-string-or-comment + (1 font-lock-comment-face nil t) + (2 font-lock-string-face nil t)) + ("([^()\n%]*\\|[^()\n]*)" . font-lock-warning-face) + ("[\200-\377]+" (0 font-lock-warning-face prepend nil))) + "Subdued level highlighting for PostScript mode.") + +;; Level 2 font-lock: +;; - All from level 1 +;; - PostScript operators (keyword face) +(defconst ps-mode-font-lock-keywords-2 + (append + ps-mode-font-lock-keywords-1 + (list + (cons + ;; exclude names prepended by `/' + (concat "\\(^\\|[^/\n]\\)" ps-mode-operators) + '(2 font-lock-keyword-face)))) + "Medium level highlighting for PostScript mode.") + +;; Level 3 font-lock: +;; - All from level 2 +;; - Immediately evaluated names: those starting with `//' (type face) +;; - Names that look like they are used for the definition of: +;; * a function +;; * an array +;; * a dictionary +;; * a "global" variable +;; (function name face) +;; - Other names (variable name face) +;; The rules used to determine what names fit in the first category are: +;; - Only names that are at the left margin, and one of these on the same line: +;; * Nothing after the name except possibly one or more `[' or a comment +;; * A `{' or `<<' or `[0-9]+ dict' following the name +;; * A `def' somewhere in the same line +;; Names are fontified before PostScript operators, allowing the use of +;; a more simple (efficient) regexp than the one used in level 2. +(defconst ps-mode-font-lock-keywords-3 + (append + ps-mode-font-lock-keywords-1 + (list + '("//\\w+" . font-lock-type-face) + '("^\\(/\\w+\\)\\>[[ \t]*\\(%.*\\)?\r?$" + . (1 font-lock-function-name-face)) + '("^\\(/\\w+\\)\\>\\([ \t]*{\\|[ \t]*<<\\|.*\\<def\\>\\|[ \t]+[0-9]+[ \t]+dict\\>\\)" + . (1 font-lock-function-name-face)) + '("/\\w+" . font-lock-variable-name-face) + (cons ps-mode-operators 'font-lock-keyword-face))) + "High level highliting for PostScript mode.") + +(defconst ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1 + "Default expressions to highlight in PostScript mode.") + +;; Level 1 font-lock for ps-run-mode +;; - prompt (function name face) +(defconst ps-run-font-lock-keywords-1 + (unless (or (not (stringp ps-run-prompt)) (string= "" ps-run-prompt)) + (list (cons (concat "^" ps-run-prompt) 'font-lock-function-name-face))) + "Subdued level highlighting for PostScript run mode.") + +(defconst ps-run-font-lock-keywords ps-run-font-lock-keywords-1 + "Default expressions to highlight in PostScript run mode.") + + +;; Variables. + +(defvar ps-mode-map nil + "Local keymap to use in PostScript mode.") + +(defvar ps-mode-syntax-table nil + "Syntax table used while in PostScript mode.") + +(defvar ps-run-mode-map nil + "Local keymap to use in PostScript run mode.") + +(defvar ps-mode-tmp-file nil + "Name of temporary file, set by `ps-run'.") + +(defvar ps-run-mark nil + "Mark to start of region that was sent to PostScript interpreter.") + +(defvar ps-run-parent nil + "Parent window of interactive PostScript.") + + +;; Menu + +(defconst ps-mode-menu-main + '("PostScript" + ["EPSF Template, Sparse" ps-mode-epsf-sparse t] + ["EPSF Template, Rich" ps-mode-epsf-rich t] + "---" + ("Cookbook" + ["RE" ps-mode-RE t] + ["ISOLatin1Extended" ps-mode-latin-extended t] + ["center" ps-mode-center t] + ["right" ps-mode-right t] + ["Heapsort" ps-mode-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]) + "---" + ["Comment Out Region" ps-mode-comment-out-region (mark t)] + ["Uncomment Region" ps-mode-uncomment-region (mark t)] + "---" + ["8-bit to Octal Buffer" ps-mode-octal-buffer t] + ["8-bit to Octal Region" ps-mode-octal-region (mark t)] + "---" + ("Auto Indent" + ["On" (setq ps-mode-auto-indent t) (not ps-mode-auto-indent)] + ["Off" (setq ps-mode-auto-indent nil) ps-mode-auto-indent]) + "---" + ["Start PostScript" + ps-run-start + t] + ["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"))] + ["Send Newline to Interpreter" + ps-mode-other-newline + (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-mode-print-buffer + t] + ["Print Region as PostScript" + ps-mode-print-region + (mark t)] + "---" + ["Customize for PostScript" + (customize-group "PostScript") + t])) + + +;; Mode maps for PostScript edit mode and PostScript interaction mode. + +(unless ps-mode-map + (setq ps-mode-map (make-sparse-keymap)) + (define-key ps-mode-map [return] 'ps-mode-newline) + (define-key ps-mode-map "\r" 'ps-mode-newline) + (define-key ps-mode-map "\t" 'ps-mode-tabkey) + (define-key ps-mode-map "\177" 'ps-mode-backward-delete-char) + (define-key ps-mode-map "}" 'ps-mode-r-brace) + (define-key ps-mode-map "]" 'ps-mode-r-angle) + (define-key ps-mode-map ">" 'ps-mode-r-gt) + (define-key ps-mode-map "\C-c\C-b" 'ps-run-buffer) + (define-key ps-mode-map "\C-c\C-c" 'ps-run-clear) + (define-key ps-mode-map "\C-c\C-j" 'ps-mode-other-newline) + (define-key ps-mode-map "\C-c\C-k" 'ps-run-kill) + (define-key ps-mode-map "\C-c\C-o" 'ps-mode-comment-out-region) + (define-key ps-mode-map "\C-c\C-p" 'ps-mode-print-buffer) + (define-key ps-mode-map "\C-c\C-q" 'ps-run-quit) + (define-key ps-mode-map "\C-c\C-r" 'ps-run-region) + (define-key ps-mode-map "\C-c\C-s" 'ps-run-start) + (define-key ps-mode-map "\C-c\C-t" 'ps-mode-epsf-rich) + (define-key ps-mode-map "\C-c\C-u" 'ps-mode-uncomment-region) + (define-key ps-mode-map "\C-c\C-v" 'ps-run-boundingbox) + (easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main)) + +(unless ps-run-mode-map + (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)) + + +;; Syntax table. + +(unless ps-mode-syntax-table + (setq ps-mode-syntax-table (make-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) + + (modify-syntax-entry ?\! "w " ps-mode-syntax-table) + (modify-syntax-entry ?\" "w " ps-mode-syntax-table) + (modify-syntax-entry ?\# "w " ps-mode-syntax-table) + (modify-syntax-entry ?\$ "w " ps-mode-syntax-table) + (modify-syntax-entry ?\& "w " ps-mode-syntax-table) + (modify-syntax-entry ?\' "w " ps-mode-syntax-table) + (modify-syntax-entry ?\* "w " ps-mode-syntax-table) + (modify-syntax-entry ?\+ "w " ps-mode-syntax-table) + (modify-syntax-entry ?\, "w " ps-mode-syntax-table) + (modify-syntax-entry ?\- "w " ps-mode-syntax-table) + (modify-syntax-entry ?\. "w " ps-mode-syntax-table) + (modify-syntax-entry ?\: "w " ps-mode-syntax-table) + (modify-syntax-entry ?\; "w " ps-mode-syntax-table) + (modify-syntax-entry ?\= "w " ps-mode-syntax-table) + (modify-syntax-entry ?\? "w " ps-mode-syntax-table) + (modify-syntax-entry ?\@ "w " ps-mode-syntax-table) + (modify-syntax-entry ?\\ "w " ps-mode-syntax-table) + (modify-syntax-entry ?^ "w " ps-mode-syntax-table) ; NOT: ?\^ + (modify-syntax-entry ?\_ "w " ps-mode-syntax-table) + (modify-syntax-entry ?\` "w " ps-mode-syntax-table) + (modify-syntax-entry ?\| "w " ps-mode-syntax-table) + (modify-syntax-entry ?\~ "w " ps-mode-syntax-table) + + (let ((i 128)) + (while (< i 256) + (modify-syntax-entry i "w " ps-mode-syntax-table) + (setq i (1+ i))))) + + +;; PostScript mode. + +;;;###autoload +(defun ps-mode () + "Major mode for editing PostScript with GNU Emacs. + +Entry to this mode calls `ps-mode-hook'. + +The following variables hold user options, and can +be set through the `customize' command: + + ps-mode-auto-indent + ps-mode-tab + ps-mode-paper-size + ps-mode-print-function + ps-run-tmp-dir + ps-run-prompt + ps-run-x + ps-run-dumb + ps-run-init + ps-run-error-line-numbers + +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) + (kill-all-local-variables) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '((ps-mode-font-lock-keywords + ps-mode-font-lock-keywords-1 + ps-mode-font-lock-keywords-2 + ps-mode-font-lock-keywords-3) + t) + 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)) + + +;; Helper functions for font-lock. + +;; When this function is called, point is at an opening bracket. +;; This function should test if point is at the start of a string +;; with nested brackets. +;; If true: move point to end of string +;; set string to match data nr 2 +;; return new point +;; If false: return nil +(defun ps-mode-looking-at-nested (limit) + (let ((first (point)) + (level 1) + pos) + ;; Move past opening bracket. + (forward-char 1) + (setq pos (point)) + (while (and (> level 0) (< pos limit)) + ;; Search next bracket, stepping over escaped brackets. + (if (not (looking-at "\\([^()\\\n]\\|\\\\.\\)*\\([()]\\)")) + (setq level -1) + (if (string= "(" (match-string 2)) + (setq level (1+ level)) + (setq level (1- level))) + (goto-char (setq pos (match-end 0))))) + (if (not (= level 0)) + nil + ;; Found string with nested brackets, now set match data nr 2. + (goto-char first) + (re-search-forward "\\(%\\)\\|\\((.*\\)" pos)))) + +;; This function should search for a string or comment +;; If comment, return as match data nr 1 +;; If string, return as match data nr 2 +(defun ps-mode-match-string-or-comment (limit) + ;; Find the first potential match. + (if (not (re-search-forward "[%(]" limit t)) + ;; Nothing found: return failure. + nil + (let (end) + (goto-char (match-beginning 0)) + (setq end (match-end 0)) + (cond ((looking-at "\\(%.*\\)\\|\\((\\([^()\\\n]\\|\\\\.\\)*)\\)") + ;; It's a comment or string without nested, unescaped brackets. + (goto-char (match-end 0)) + (point)) + ((ps-mode-looking-at-nested limit) + ;; It's a string with nested brackets. + (point)) + (t + ;; Try next match. + (goto-char end) + (ps-mode-match-string-or-comment limit)))))) + + +;; Key-handlers. + +(defun ps-mode-target-column () + "To what column should text on current line be indented? + +Identation is increased if the last token on the current line +defines the beginning of a group. These tokens are: { [ <<" + (save-excursion + (beginning-of-line) + (if (looking-at "[ \t]*\\(}\\|\\]\\|>>\\)") + (condition-case err + (progn + (goto-char (match-end 0)) + (backward-sexp 1) + (beginning-of-line) + (if (looking-at "[ \t]+") + (goto-char (match-end 0))) + (current-column)) + (error + (ding) + (message (error-message-string err)) + 0)) + (let (target) + (if (not (re-search-backward "[^ \t\n\r\f][ \t\n\r\f]*\\=" nil t)) + 0 + (goto-char (match-beginning 0)) + (beginning-of-line) + (if (looking-at "[ \t]+") + (goto-char (match-end 0))) + (setq target (current-column)) + (end-of-line) + (if (re-search-backward "\\({\\|\\[\\|<<\\)[ \t]*\\(%[^\n]*\\)?\\=" nil t) + (setq target (+ target ps-mode-tab))) + target))))) + +(defun ps-mode-newline () + "Insert newline with proper indentation." + (interactive) + (delete-horizontal-space) + (insert "\n") + (if ps-mode-auto-indent + (indent-to (ps-mode-target-column)))) + +(defun ps-mode-tabkey () + "Indent/reindent current line, or insert tab" + (interactive) + (let ((column (current-column)) + target) + (if (or (not ps-mode-auto-indent) + (< ps-mode-tab 1) + (not (re-search-backward "^[ \t]*\\=" nil t))) + (insert "\t") + (setq target (ps-mode-target-column)) + (while (<= target column) + (setq target (+ target ps-mode-tab))) + (delete-horizontal-space) + (indent-to target)))) + +(defun ps-mode-backward-delete-char () + "Delete backward indentation, or delete backward character" + (interactive) + (let ((column (current-column)) + target) + (if (or (not ps-mode-auto-indent) + (< ps-mode-tab 1) + (not (re-search-backward "^[ \t]+\\=" nil t))) + (delete-backward-char 1) + (setq target (ps-mode-target-column)) + (while (> column target) + (setq target (+ target ps-mode-tab))) + (while (>= target column) + (setq target (- target ps-mode-tab))) + (if (< target 0) + (setq target 0)) + (delete-horizontal-space) + (indent-to target)))) + +(defun ps-mode-r-brace () + "Insert `}' and perform balance." + (interactive) + (insert "}") + (ps-mode-r-balance "}")) + +(defun ps-mode-r-angle () + "Insert `]' and perform balance." + (interactive) + (insert "]") + (ps-mode-r-balance "]")) + +(defun ps-mode-r-gt () + "Insert `>' and perform balance." + (interactive) + (insert ">") + (ps-mode-r-balance ">>")) + +(defun ps-mode-r-balance (right) + "Adjust indentification if point after RIGHT." + (if ps-mode-auto-indent + (save-excursion + (when (re-search-backward (concat "^[ \t]*" (regexp-quote right) "\\=") nil t) + (delete-horizontal-space) + (indent-to (ps-mode-target-column))))) + (blink-matching-open)) + +(defun ps-mode-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-mode-print-buffer () + "Print buffer as PostScript" + (interactive) + (eval (list ps-mode-print-function))) + +(defun ps-mode-print-region (begin end) + "Print region as PostScript, adding minimal header and footer lines: + +%!PS +<region> +showpage +" + (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-mode-print-function)) + (set-buffer oldbuf) + (kill-buffer tmpbuf))) + + +;; Comment Out / Uncomment. + +(defun ps-mode-comment-out-region (begin end) + "Comment out region." + (interactive "r") + (let ((endm (make-marker))) + (set-marker endm end) + (save-excursion + (goto-char begin) + (if (= (current-column) 0) + (insert "%")) + (while (and (= (forward-line) 0) + (< (point) (marker-position endm))) + (insert "%"))) + (set-marker endm nil))) + +(defun ps-mode-uncomment-region (begin end) + "Uncomment region. + +Only one `%' is removed, and it has to be in the first column." + (interactive "r") + (let ((endm (make-marker))) + (set-marker endm end) + (save-excursion + (goto-char begin) + (if (looking-at "^%") + (delete-char 1)) + (while (and (= (forward-line) 0) + (< (point) (marker-position endm))) + (if (looking-at "%") + (delete-char 1)))) + (set-marker endm nil))) + + +;; Convert 8-bit to octal codes. + +(defun ps-mode-octal-buffer () + "Change 8-bit characters to octal codes in buffer." + (interactive) + (ps-mode-octal-region (point-min) (point-max))) + +(defun ps-mode-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"))) + (set-marker endm nil))))) + + +;; Cookbook. + +(defun ps-mode-center () + "Insert function /center." + (interactive) + (insert " +/center { + dup stringwidth + exch 2 div neg + exch 2 div neg + rmoveto +} bind def +")) + +(defun ps-mode-right () + "Insert function /right." + (interactive) + (insert " +/right { + dup stringwidth + exch neg + exch neg + rmoveto +} bind def +")) + +(defun ps-mode-RE () + "Insert function /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-mode-latin-extended () + "Insert array /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-mode-heapsort () + "Insert function /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-mode-epsf-sparse () + "Insert sparse EPSF template." + (interactive) + (goto-char (point-max)) + (unless (re-search-backward "%%EOF[ \t\n]*\\'" nil t) + (goto-char (point-max)) + (insert "\n%%EOF\n")) + (goto-char (point-max)) + (unless (re-search-backward "\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t) + (re-search-backward "%%EOF") + (insert "showpage\n")) + (goto-char (point-max)) + (unless (re-search-backward "\\bend[ \t\n]+\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t) + (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-mode-paper-size) + (car (cdr ps-mode-paper-size)))) + (insert "64 dict begin\n\n")) + +(defun ps-mode-epsf-rich () + "Insert rich EPSF template." + (interactive) + (ps-mode-epsf-sparse) + (forward-line -3) + (when 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-mode () + "Major mode in interactive PostScript window. +This mode is invoked from ps-mode and should not be called directly. + +\\{ps-run-mode-map} +" + (kill-all-local-variables) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults (list (list 'ps-run-font-lock-keywords + 'ps-run-font-lock-keywords-1 + (append + ps-run-font-lock-keywords-1 + ps-run-messages)) + t) + 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-running () + "Error if not in ps-mode or not running PostScript." + (unless (equal major-mode 'ps-mode) + (error "This function can only be called from PostScript mode")) + (unless (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) + (unless command + (error "No command specified to run interactive PostScript")) + (unless (and ps-run-mark (markerp ps-run-mark)) + (setq ps-run-mark (make-marker))) + (when ps-run-init + (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) + (when (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 (match-string 1) + y1 (match-string 2) + x2 (match-string 3) + y2 (match-string 4))) + (unless (< (string-to-number x1) (string-to-number x2)) + (error "x1 (%s) should be less than x2 (%s)" x1 x2)) + (unless (< (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)) + (when 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 () + (unless ps-mode-tmp-file + (cond (ps-run-tmp-dir) + ((setq ps-run-tmp-dir (getenv "TEMP"))) + ((setq ps-run-tmp-dir (getenv "TMP"))) + ((setq ps-run-tmp-dir (getenv "HOME")) + (setq + ps-run-tmp-dir + (concat (file-name-as-directory ps-run-tmp-dir) "tmp")) + (unless (file-directory-p ps-run-tmp-dir) + (setq ps-run-tmp-dir nil)))) + (unless ps-run-tmp-dir + (setq ps-run-tmp-dir "/tmp")) + (setq ps-mode-tmp-file + (make-temp-name + (concat + (if ps-run-tmp-dir + (file-name-as-directory ps-run-tmp-dir) + "") + "ps-run-")))) + ps-mode-tmp-file) + +;; Remove temporary file +;; This shouldn't fail twice, because it is called at kill-emacs +(defun ps-run-cleanup () + (when ps-mode-tmp-file + (let ((i ps-mode-tmp-file)) + (setq ps-mode-tmp-file nil) + (when (file-exists-p i) + (delete-file i))))) + +(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) + (when (and (stringp ps-run-prompt) (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))) + (unless (looking-at "[0-9]") + (goto-char (max 1 (1- (point))))) + (when (looking-at "[0-9]") + (forward-char 1) + (forward-word -1) + (when (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)) + (end-of-line)) + (goto-char (+ i (marker-position ps-run-mark))))))))) + + +;; +(add-hook 'kill-emacs-hook 'ps-run-cleanup) + +(provide 'ps-mode) + +;;; ps-mode.el ends here