;;; $Header: ps-mode.el,v 1.2 89/07/15 16:49:59 sarantos Exp $ ;;; For building this code, I borrowed ideas from other modes: ;;; The identation calculation looks like a simplified version of the ;;; c-mode, the comments as in lisp-mode, the inferior processes like ;;; in inferior-lisp mode and the header inclusion and shell-execution ;;; like the tex-mode. But the postscript string syntax, and the bracket ;;; usage is unique, since brackets usually match, and we want indentation ;;; in that case, but may not match, since the command mark may have been ;;; used, or we may pop the mark, or make complex stack manipulations. ;;; So for completely correct postscript syntax, the advanced emacs ;;; parsing functions are of no use and I had to use my own. ;;; I tried to use names similar to the corresponding names on the other ;;; modes, for readability and better understanding of the code. ;;; Conforming comments are obeyed. ;;; Usage example: ;;load: (autoload 'ps-mode "ps-mode" nil t) ;;load: (setq auto-mode-alist ;;load: (nconc '( ;;load: ("\\.ps$" . ps-mode) ;;load: ("\\.eps$" . ps-mode) ;;load: ("\\.pse$" . ps-mode) ;;load: ("\\.psi$" . ps-mode) ;;load: ("\\.PS$" . ps-mode) ;;load: ) ;;load: auto-mode-alist)) (provide 'ps-mode) (defvar ps-brace-indent 2 "*Indentation of statements with respect to containing block.") (defvar ps-bracket-indent 2 "*Indentation of statements with respect to containing block.") (defvar ps-brace-offset 0 "*Extra indentation for braces, compared with other text in same context.") (defvar ps-brace-imaginary-offset 0 "*Imagined indentation of an open brace that follows a non empty line.") (defvar ps-auto-newline nil "*Non-nil means automatically newline before and after braces inserted.") (defvar ps-tab-always-indent t "*Non-nil means \\[ps-indent-command] in postscript mode should always reindent the current line, regardless of where in the line point is when the \\[ps-indent-command] function is used.") (defvar ps-comment-at-bol "%[%!]\\(\\([A-Z][A-Za-z0-9]*\\)\\(:.*\\)?\\)?\n" "*Regular expression for comments that, when indented, go to column 0.") (defvar ps-comment-ok-pos "%%%" "*Regular expression for comments that, when indented, never move.") (defvar inferior-ps-prompt "^[^#$%>]*[#$%>] *" "*Regexp to recognize prompts from the inferior postscript process. The prompt will be excluded from the beginning of each line of the buffer, on every input copy.") (defvar inferior-ps-program nil "*Program for invoking an interactive inferior postscript with \\[ps-run]. This program should be interactive, (that is to reply to the input given as soon as it is processed, and not when the end of file is reached) and should use the standard input and output for this communication. The process starts running with \\[ps-run], or by using any of the functions that send input to it (their names start with ``ps-send-''), which are: \\[ps-send-region], \\[ps-send-buffer] and \\[ps-send-defun]. The program runs on the buffer *ps*, and you can interact directly with the interpreter through that buffer (by typing, including files, copying text, etc), which has all the bindings of the shell-mode, and most of the bindings of the ps-mode (except these related to other processes), or send input to it by any other buffer, using the process-related functions. Its value can be either a string, or a function or variable, which is then recursively evaluated until a string (or nil) is produced.") (defvar ps-shell-command nil "*The command to run postscript on a file using the functions \\[ps-file], \\[ps-buffer], \\[ps-region] and \\[ps-page]. The command does not have to be interactive, and should take as argument a file name which is appended to the command (after a space) if the string of the command does not contain the ``%s'' substring, or is regarded as a format otherwise, taking the file name as an argument. Nearly any command can be used for this purpose, and usual settings will be a printer or a remote execution of a command to another host. A temporary file is used, if needed, and the prolog, as marked by \\[ps-mark-prolog], is always inside the file given as input to the command. The command is always run on a special subshell, on the buffer *ps-shell* and the full path name is used on the file name (so that remote commands do work). This command can either be a string, or a function, which is called with argument the file-name, or a variable, which is evaluated. As long as they evaluate to a function or variable, the evaluation goes on recursively, and finally the produced command should be either a string or nil (meaning no command). If the last evaluation was not a function call and the command is a string, a space and the file name is appended to it, unless it contains the substring ``%s'', in which case it is handled as a format to produce the command, with the file name substituting the ``%s''. If no such command is specified, then the inferior-ps-program is used.") (defvar ps-file-command '(lambda (x) (if inferior-ps-program 'inferior-ps-program 'ps-shell-command)) "*The command to run postscript on a file (using \\[compile-file]). If no such command is specified, then the inferior-ps-program is used, and if it is not defined either, the ps-shell-command is used. The command does not have to be interactive, and should take as argument a file name which is appended to the command (after a space) if the string of the command does not contain the ``%s'' substring, or is regarded as a format otherwise, taking the file name as an argument. Since the output of the command can be processed by \\[next-error], a filter that has the correct output format will be preferable. Its value can be either string, or function or variable, which is then evaluated until a string (or nil) is produced (see compile-file-command).") (defvar ps-check-command 'inferior-ps-program "*Shell command to send the postscript code for testing or execution. The text is send as input to this process (no file is written), and then emacs waits for the completion of the execution. Any output will be displayed in a scratch buffer. The command does not have to be interactive, as each time it is called we start a new process, and send the input and then end of file, and may produce output to other media, like printers, graphics terminals, etc, (but in that case we cannot see them from inside emacs). Its main purpose is to locate execution errors on a postscript piece of code (and each time we start a new process, for error recovery), no matter where they are going to be reported (on a printer, on another host, etc). Its value can be either string, or function or variable, which are then evaluated until a string (or nil) is produced. If no such command is specified, then the inferior-ps-program is used.") ;; The names contain the word header, for compatibility with tex-mode. (defvar ps-start-of-header "^%!PS-Adobe-" "*Regexp used by \\[ps-region] to delimit the start of the file's header.") (defvar ps-end-of-header "^%%EndProlog$" "*Regexp used by \\[ps-region] to delimit the end of the file's header.") (defvar ps-page-separator "^%%Page:.*\n" "*Regexp used by \\[ps-region] to delimit the end of the file's header.") (defvar ps-non-recursive-header nil "*nil, if a header can include another.") (defvar ps-directory "/tmp/" "*Directory in which to run the postscript subjobs on the *ps-shell* buffer and in which temporary files for ps-shell-command will be created. If you use a ps-shell-command that is executed remotely on another host, you have better define a directory accessible by both hosts.") (defvar ps-zap-file nil "Temporary file name used for text being sent as input to ps. It may have an extension, but it should not have a directory specification. If it is nil, a default name will be computed when needed.") (defvar ps-shell-cd-command "cd" "Command to give to shell running postscript to change directory. The value of ps-directory will be appended to this, separated by a space.") (defvar ps-mode-abbrev-table nil "Abbrev table in use in ps-mode.") (defvar ps-mode-map nil "Keymap used in ps-mode.") (defvar inferior-ps-mode-map nil "Keymap used in inferior-ps-mode.") (defun ps-mode-common-shell-keys (map) (define-key map "\C-c\C-k" 'ps-kill-job) (define-key map "\C-c\C-l" 'ps-recenter-output-buffer)) (defun ps-mode-common-inferior-keys (map) (define-key map "{" 'ps-electric-brace) (define-key map "}" 'ps-electric-brace) (define-key map "[" 'ps-electric-bracket) (define-key map "]" 'ps-electric-bracket) (define-key map "\e\C-h" 'ps-mark-function) (define-key map "\e\C-q" 'ps-indent-exp) (define-key map "\e\t" 'ps-complete-symbol) (define-key map "\177" 'backward-delete-char-untabify) (define-key map "\t" 'ps-indent-command)) (if ps-mode-map nil (setq ps-mode-map (make-sparse-keymap)) (define-key ps-mode-map "\e\C-x" 'ps-check-region) (define-key ps-mode-map "\C-c\t" 'ps-complete-symbol) (define-key ps-mode-map "\C-cb" 'lpr-buffer) (define-key ps-mode-map "\C-cr" 'lpr-region) (define-key ps-mode-map "\C-c\C-@" 'ps-mark-prolog) (define-key ps-mode-map "\C-c\C-q" 'ps-fill-hex-region) (define-key ps-mode-map "\C-c\C-\\" 'ps-fill-split-region) (define-key ps-mode-map "\C-c\C-o" 'ps-split-region) (define-key ps-mode-map "\C-cg" 'ps-fill-region) (ps-mode-common-shell-keys ps-mode-map) (define-key ps-mode-map "\C-c\C-b" 'ps-buffer) (define-key ps-mode-map "\C-c\C-p" 'ps-page) (define-key ps-mode-map "\C-c\C-r" 'ps-region) (define-key ps-mode-map "\C-c\C-f" 'ps-file) (ps-mode-common-inferior-keys ps-mode-map) (define-key ps-mode-map "\C-c\C-e" 'ps-run) (define-key ps-mode-map "\C-c\C-x" 'ps-send-defun) (define-key ps-mode-map "\C-c\C-c" 'ps-send-region) (define-key ps-mode-map "\C-c\C-h" 'ps-send-buffer)) (defvar ps-mode-syntax-table nil "Syntax table in use in ps-mode.") (if ps-mode-syntax-table nil (setq ps-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?! "_" ps-mode-syntax-table) (modify-syntax-entry ?\" "_" ps-mode-syntax-table) (modify-syntax-entry ?# "_" ps-mode-syntax-table) (modify-syntax-entry ?' "_" ps-mode-syntax-table) (modify-syntax-entry ?, "_" ps-mode-syntax-table) (modify-syntax-entry ?. "_" ps-mode-syntax-table) (modify-syntax-entry ?: "_" ps-mode-syntax-table) (modify-syntax-entry ?; "_" ps-mode-syntax-table) (modify-syntax-entry ?? "_" ps-mode-syntax-table) (modify-syntax-entry ?@ "_" ps-mode-syntax-table) (modify-syntax-entry ?^ "_" ps-mode-syntax-table) (modify-syntax-entry ?` "_" ps-mode-syntax-table) (modify-syntax-entry ?~ "_" ps-mode-syntax-table) (modify-syntax-entry ?% "<" ps-mode-syntax-table) (modify-syntax-entry ?\f ">" ps-mode-syntax-table) (modify-syntax-entry ?\n ">" ps-mode-syntax-table) (modify-syntax-entry ?< "(>" ps-mode-syntax-table) (modify-syntax-entry ?> ")<" ps-mode-syntax-table)) ;;; Use by ps-mode and inferior-ps-mode (defun ps-mode-common-initialization () (kill-all-local-variables) (make-local-variable 'page-delimiter) (make-local-variable 'paragraph-start) (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-ignore-fill-prefix) (make-local-variable 'indent-line-function) (make-local-variable 'indent-region-function) (make-local-variable 'comment-column) (make-local-variable 'comment-start) (make-local-variable 'comment-start-skip) (make-local-variable 'comment-indent-hook) (set-syntax-table ps-mode-syntax-table) (setq local-abbrev-table ps-mode-abbrev-table page-delimiter (concat ps-page-separator "\\|" page-delimiter) paragraph-start (concat "^$\\|" page-delimiter) paragraph-separate paragraph-start paragraph-ignore-fill-prefix t indent-line-function 'ps-indent-line indent-region-function 'ps-indent-region comment-column 40 comment-start "% " comment-start-skip "%+[ \t]*" comment-indent-hook 'ps-comment-indent)) (defun ps-mode () "Major mode for postscript language editing. Strings and comments are recognized, and brackets are matched if possible, but not necessarily, as braces. The basic conforming comments are known and are used to locate some structured elements of the text (like prolog and pages). Also there is interface for execution both remote execution of (parts of) the postscript code, and interaction with a postscript interpreter, if these programs are available on the local environment. Finally, there is completions on display postscript operators and the basic conforming comments. \\[ps-indent-command] indents for postscript code. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{ps-mode-map} Variables controlling indentation style: ps-brace-indent ps-bracket-indent Indentation of statements with respect to containing block. The surrounding block's indentation is the indentation of the line on which the open brace or bracket appears. ps-brace-offset Extra indentation for braces, compared with other text in same context. ps-brace-imaginary-offset Imagined indentation of an open brace that follows a non empty line. ps-auto-newline Non-nil means automatically newline before and after braces inserted. ps-tab-always-indent Non-nil means \\[ps-indent-command] in postscript mode should always reindent the current line, regardless of where in the line point is when the \\[ps-indent-command] function is used. ps-comment-at-bol Regular expression for comments that, when indented, go to column 0. ps-comment-ok-pos Regular expression for comments that, when indented, never move. Variables controlling postscript execution: inferior-ps-prompt Regexp to recognize prompts from the inferior postscript process. The prompt will be excluded from the beginning of each line of the buffer, on every input copy. inferior-ps-program Program for invoking an interactive inferior postscript with \\[ps-run]. This program should be interactive, (that is to reply to the input given as soon as it is processed, and not when the end of file is reached) and should use the standard input and output for this communication. The process starts running with \\[ps-run], or by using any of the functions that send input to it (their name start with ps-send-), which are: \\[ps-send-region], \\[ps-send-buffer] and \\[ps-send-defun]. The program runs on the buffer *ps*, and you can interact directly with the interpreter through that buffer (by typing, including files, copying text, etc), which has all the bindings of the shell-mode, and most of the bindings of the ps-mode (except these related to other processes), or send input to it by any other buffer, using the process-related functions. ps-shell-command The command to run postscript on a file using the functions \\[ps-file], \\[ps-buffer], \\[ps-region] and \\[ps-page]. The command does not have to be interactive, and should take as argument a file name which is appended to the command (after a space) if the string of the command does not contain the ``%s'' substring, or is regarded as a format otherwise, taking the file name as an argument. Nearly any command can be used for this purpose, and usual settings will be a printer or a remote execution of the command to another host. A temporary file is used, if needed, and the prolog, as marked by \\[ps-mark-prolog], is always inside the file given to the command. The command is always run on a special subshell, on the buffer *ps-shell* and the full path name is used on the file name (so that remote commands do work). ps-file-command The command to run postscript on a file (using \\[compile-file]). If no such command is specified, then the inferior-ps-program is used, and if it is not defined either, the ps-shell-command is used. The command does not have to be interactive, and should take as argument a file name which is appended to the command (after a space) if the string of the command does not contain the ``%s'' substring, or is regarded as a format otherwise, taking the file name as an argument. Since the output of the command can be processed by \\[next-error], a filter that has the correct output format will be preferable. ps-check-command Shell command to send the postscript code for testing or execution. The text is send as input to this process (no file is written), and then emacs waits for the completion of the execution. Any output will be displayed in a scratch buffer. The command does not have to be interactive, as each time it is called we start a new process, and send the input and then end of file, and may produce output to other media, like printers, graphics terminals, etc, (but in that case we cannot see them from inside emacs). Its main purpose is to locate execution errors on a postscript piece of code (and each time we start a neew process, for error recovery), no matter where they are going to be reported (on a printer, on another host, etc). If no such command is specified, then the inferior-ps-program is used. ps-directory Directory in which temporary files for ps-shell-command will be created. If you use a ps-shell-command that is executed remotely on another host, you have better define a directory accessible by both hosts. The above variables can evaluate to either strings, functions or variables, which are then evaluated until a string (or nil) is produced. These variables are evaluated every time the commands are needed, so that changing variables that they may depend on, will affect them. If there are programs that can serve these purposes on your local environment, you should set these variables accordingly. The default values will usually be inadequate. Variables controlling the prolog (the prolog is always prepended to the \\[ps-region] function): ps-start-of-header Regexp used by \\[ps-region] to delimit the start of the file's header. ps-end-of-header Regexp used by \\[ps-region] to delimit the end of the file's header. ps-non-recursive-header nil, if a header can include another. Calling the ps-mode calls the value of the variable ps-mode-hook with no args, if that is non-nil." (interactive) (ps-mode-common-initialization) (make-local-variable 'compile-file-command) (make-local-variable 'require-final-newline) (use-local-map ps-mode-map) (setq major-mode 'ps-mode mode-name "ps" compile-file-command 'ps-file-command require-final-newline t) (run-hooks 'ps-mode-hook)) ;;; General purpose functions (basic key bindings) (defun ps-electric-brace (arg) "Insert character and, if no argument is given, correct line's indentation. The variable ps-auto-newline controls if the character will be alone in a line, when inserted as the last character in the line. If the character is not alone in the line (except preceding indentation), the line is not reindented in any case." (interactive "*P") (let (insertpos) (if (and (null arg) (eolp) (or (save-excursion (skip-chars-backward " \t") (bolp)) (if ps-auto-newline (progn (ps-indent-line) (newline) t)))) (progn (insert last-command-char) (ps-indent-line) (if ps-auto-newline (progn (newline) ;; (newline) may have done auto-fill (setq insertpos (- (point) 2)) (ps-indent-line))) (save-excursion (if insertpos (goto-char (1+ insertpos))) (delete-char -1)))) (if insertpos (save-excursion (goto-char insertpos) (self-insert-command (prefix-numeric-value arg))) (self-insert-command (prefix-numeric-value arg))))) (defun ps-electric-bracket (arg) "Insert character and correct line's indentation. If either an argument is given, or the character is not in a line by itself (followed by optional indentation), the line's indentation is not affected." (interactive "*P") (if (and (null arg) (eolp) (or (save-excursion (skip-chars-backward " \t") (bolp)))) (progn (insert last-command-char) (ps-indent-line) (save-excursion (delete-char -1)))) (self-insert-command (prefix-numeric-value arg))) (defun ps-mark-function (&optional nomsg) "Put mark at end of postscript function, point at beginning. Only multiline functions are marked this way, and a blank line should precede their definition as well as the top level opening brace of the function should be on the first column of its line." (interactive) (push-mark (point) nomsg) (beginning-of-line) ;; go after the function header (while (looking-at "[^ \t]") (forward-line 1)) (beginning-of-defun) (push-mark (point) nomsg) (ps-parse-partial-sexp (point) nil 0) (if (or (looking-at "\n") (looking-at comment-start-skip)) nil (forward-line 1)) (exchange-point-and-mark) (forward-paragraph -1)) ;;; Mark the prolog of the postscript file. ;;; If recursive prolog is expected, the file is (in the worst case) ;;; traversed twice, once for the starting string and once for the ;;; ending string (although the algorithm is not really recursive). ;;; This search does not recognize other conforming comments, like ;;; BeginDocument, etc, but assumes that if they contain an EndProlog, ;;; they also contain (before that) a PS-Adobe- line. ;;; Non interactively, if a non nil argument is provided, no error is ;;; signaled if a header cannot be found, but nil is returned instead. (defun ps-mark-prolog (&optional nomsg) "Mark the buffer's prolog, which is is all lines between the strings defined by ps-start-of-header and ps-end-of-header inclusive. The header must start in the first line. If the variable ps-non-recursive-header is nil, recursive inclusions of prologs are allowed. The default values for these strings agree with the conforming standards. The prolog is always included on all input send to the ps-shell-command." (interactive) (let ((beg (point-min)) (end (point-min)) (pos (point))) (if (save-excursion (save-restriction (widen) (goto-char beg) (if (and ps-start-of-header (looking-at ps-start-of-header)) (if ps-non-recursive-header (if (re-search-forward ps-end-of-header nil t) (progn (forward-line 1) (setq end (point)))) (while (if (re-search-forward ps-end-of-header nil t) (progn (forward-line 1) (setq end (point)) (goto-char beg) (forward-line 1) (if (re-search-forward ps-start-of-header end t) (setq beg (point)))) (setq end nil)) (goto-char end)) end) ))) (progn (push-mark pos nomsg) (push-mark end nomsg) (goto-char (point-min)) t) (if nomsg nil (error (if end "No prolog found" (format "Not enough %s found" ps-end-of-header))))))) (defun ps-fill-hex-region (beg end arg) "Fill the (hopefully) part of hexadecimal postscript string in the region up to the ARG column, or the fill-column, if no arg is given. All other characters except the legal hexadecimal digits and the newlines needed, will be removed." (interactive "*r\nP") (setq arg (if arg (prefix-numeric-value arg) fill-column)) (save-excursion (save-restriction (narrow-to-region beg end) (replace-regexp "[^0-9A-Fa-f]" "") (let ((n (/ (- (point-max) (point-min) 1) arg))) (goto-char (point-min)) (while (null (zerop n)) (forward-char arg) (insert ?\n) (setq n (1- n))))))) (defun ps-fill-region (beg end) "Concatenate all lines in the region that do not end on a comment or an open string. It an be used for making the region more compact, or for spliting it afterwards." (interactive "*r") (save-excursion (save-restriction (narrow-to-region (point-min) end) (goto-char beg) (beginning-of-line) (let (state first last) (while (null (eobp)) (if first (progn (skip-chars-forward " \t\n") (if (looking-at comment-start-skip) ;; delete blanks at the end of the code (delete-region first last) (delete-region first (point)) (insert ?\ )))) (while (progn (setq state (ps-parse-partial-sexp (point) (progn (end-of-line) (point)) nil nil state t)) (= (following-char) ?\})) (forward-char 1)) (if (or (nth 3 state) (nth 4 state)) (progn (setq first nil) (setcar (nthcdr 4 state) nil)) (setq last (point)) (skip-chars-backward " \t") (setq first (point))) (if (eobp) nil (forward-char 1))))))) ;;; Can be designed more efficiently, by calling the ps-parse-partial-sexp ;;; less times, and taking advantage that the state is the same on the two ;;; ends of an sexp. (defun ps-split-region (beg end) "Split each line in the region into more lines, that do not exceed the column fill-column, if possible. Comments and strings are not split. Also, sexp are not split if they can fit in one line (and are moved in a new line, if necessary). Contents of different lines are never joined by this function, use ps-fill-region for that purpose." (interactive "*r") (ps-split-region1 beg end) ;;; @@@@@@@@ ) ;;; A more efficient implementation could do both at the same time. ;;; But I don't have the time to write it now. (defun ps-fill-split-region (beg end) "Execute a \\[ps-fill-region] and a \\[ps-split-region] on the region." (interactive "*r") (let ((mark (set-marker (make-marker) end))) (ps-fill-region beg end) (ps-split-region beg mark) (set-marker mark nil))) ;;; Postscript parsing functions: ;;; I don't use the syntax table and comment-start-skip, since this ;;; parsing is unique for postscript (string syntax, [] do not always nest) ;;; The following code is legal, for example: mark 1 2 ] ... [ pop ;;; On the other hand, we want to indent the normal usages of [ and ]. ;;; Strings are sexp, but they often contain unmatched brackets, e.t.c. ;;; (especially since postscript does not have a format command, to keep ;;; all the parenthesis together), so I cannot take advantage of that. ;;; ;;; Is \\c legal outside strings ? I assume it has no special semantics ;;; outside strings. (defun ps-end-string (depth) "Find the end of the string, when point is already DEPTH parentheses deep. If DEPTH is 0, it means a hex string. If DEPTH is negative, means skip the first character, and then proceed as when DEPTH was its absolute value. The return value is nil if the end of the string is found, or expresses the new DEPTH at the end of the buffer, which will be 0 for hex strings and positive or negative otherwise." (interactive "p") (if (zerop depth) (if (search-forward ">" nil 'move) nil 0) (if (< depth 0) (progn (forward-char 1) (setq depth (- depth)))) (while (progn (skip-chars-forward "^\\()") (cond ((= (following-char) ?\() (forward-char 1) (setq depth (1+ depth))) ((= (following-char) ?\)) (forward-char 1) (if (zerop (setq depth (1- depth))) (setq depth nil) t)) ((= (following-char) ?\\) (forward-char 1) (if (eobp) (progn (setq depth (- depth)) nil) (forward-char 1) t)) (t nil)))) depth)) ;;; stopbefore is ignored (but it is not hard to add it), ;;; since I don't use it anywhere ;;; and parse-partial-sexp would proceed to the same point anyway. ;;; Also, for efficiency, this function modifies the same state, ;;; if one is given, instead of building a new one. (defun ps-parse-partial-sexp (beg end &optional targetdepth stopbefore state noerr) "Similar to the parse-partial-sexp, but adjusted for postscript. Going to negative depths is NOT allowed, since the opening delimiter will be unknown. The extra argument specifies the behavior at this case. It it is nil, an error is raised, while otherwise parsing just stops. State has been extended to have one more element, the list of active open delimiters ?\{ and ?\[. Also, the fourth element of the state (accessed by: nth 3 state, meaning parsing stopped inside a string) has a slightly different meaning if non nil (instead of describing the closing delimiter): if point is inside a hex string, it is (the number) 0, otherwise it is the number of closing parenthesis we need to terminate the string (always positive), or the opposite, if we need first to omit one character (usually a quoted character or an opening delimiter)." (save-restriction (narrow-to-region (point-min) end) (goto-char beg) (let (depth innermost-list min-depth list done) (if (and state (null (eobp))) (progn (if (nth 4 state) ;; Inside a comment (if (progn (forward-line 1) (= (preceding-char) ?\n)) (setcar (nthcdr 4 state) nil)) (if (nth 3 state) (setcar (nthcdr 3 state) (ps-end-string (nth 3 state))))) (setq list (nth 7 state) depth (car state) min-depth depth)) (setq state (make-list 8 nil) depth 0 min-depth 0)) (while (progn ;; ?\) , ?\> and ?\\ are not expected to be found here. ;; and they are handled as simple chars, if found. (skip-chars-forward "^%<({}[]" end) (cond ((= (following-char) ?%) (forward-line 1) (if (= (preceding-char) ?\n) t (setcar (nthcdr 4 state) t) nil)) ((= (following-char) ?\<) (if (ps-end-string 0) (progn (setcar (nthcdr 3 state) 0) nil) t)) ((= (following-char) ?\() (forward-char 1) (if (setq done (ps-end-string 1)) (progn (setcar (nthcdr 3 state) done) nil) t)) ((memq (following-char) '(?\{ ?\[)) (prog1 (null (eq (setq list (cons (point) list) depth (1+ depth)) targetdepth)) (forward-char 1))) ((= (following-char) ?\}) (forward-char 1) (while (and list (= (char-after (car list)) ?\[)) (if (eq (setq list (cdr list) depth (1- depth)) targetdepth) (setq done t))) (if list (null (or (eq (setq innermost-list (car list) min-depth (min min-depth (1- depth)) list (cdr list) depth (1- depth)) targetdepth) done)) ;; An outer block found, so we quit. ;; depth is 0 now. (if noerr (forward-char -1) (error "Unmatched } found")) nil)) ((= (following-char) ?\]) (forward-char 1) (if (and list (= (char-after (car list)) ?\[)) (null (eq (setq innermost-list (car list) min-depth (min min-depth (1- depth)) list (cdr list) depth (1- depth)) targetdepth)) t)) (t nil))) ) (setcar state depth) (setcar (cdr state) (and list (car list))) (setcar (nthcdr 2 state) innermost-list) (setcar (nthcdr 6 state) min-depth) (setcar (nthcdr 7 state) list))) state) ;;; Postscript indenting functions: ;; This is used by indent-for-comment ;; to decide how much to indent a postscript comment based on its context, ;; trying to move it to the comment column. (defun ps-comment-indent () (if (looking-at ps-comment-ok-pos) (current-column) (save-excursion (skip-chars-backward " \t") (if (bolp) comment-column (max (1+ (current-column)) comment-column))))) (defun ps-indent-command (&optional whole-exp) "Indent current line as postscript code, or in some cases insert a tab character. If ps-tab-always-indent is non-nil (the default), always indent current line. Otherwise, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. A numeric argument, regardless of its value, means indent rigidly all the lines of the expression starting after point so that this line becomes properly indented. The relative indentation among the lines of the expression are preserved." (interactive "*P") (if (or whole-exp ps-tab-always-indent (save-excursion (skip-chars-backward " \t") (bolp))) (ps-indent-line whole-exp) (insert-tab))) (defun ps-indent-line (&optional whole-exp) "Indent current line as postscript code, without changing indentation inside the line. With argument, indent any additional lines of the same expression rigidly along with this one." (interactive "*P") (let (indent shift-amt beg end) (save-excursion (beginning-of-line) (skip-chars-forward " \t") (setq indent (current-column)) (ps-indent-region (point) (point) t t) (skip-chars-forward " \t") (setq shift-amt (- (current-column) indent) beg (point))) ;; If initial point was within line's indentation, ;; position after the indentation. (if (< (point) beg) (goto-char beg)) ;; If desired, shift remaining lines of expression the same amount. (if (and (null (zerop shift-amt)) whole-exp (save-excursion (save-excursion (forward-line 1) (setq beg (point))) (while (< (point) beg) (forward-sexp 1) (setq end (point)) (skip-chars-forward " \t\n")) (> end beg))) ;; Don't change indentation on lines starting on a comment. (indent-code-rigidly beg end shift-amt comment-start-skip)))) (defun ps-indent-region (beg end &optional fixed-comments indent-newline) "Indent the region, like applying TAB on every line. The differences are that empty lines are not indented to the current indentation level, like TAB does, and comments that follow commands on lines (and do not occupy a line by themselves) will be indented, to the coment-column. When used non interactively, these default actions can be changed by giving non nil arguments FIXED-COMMENTS and INDENT-NEWLINE, while the region is specified by the first two arguments BEG and END." (interactive "r") (save-excursion (save-restriction ;; Include the last line ;; so that its contents can be used for indentation (goto-char end) (end-of-line) (setq end (point)) (widen) ;; Parsing starts at the closest top level point: ;; (Everything before that, will be hidden). (goto-char beg) (beginning-of-defun) (narrow-to-region (point) end) (goto-char beg) (ps-indent-exp t fixed-comments indent-newline)))) (defun ps-calculate-indent (containing-sexp) "Return appropriate indentation for current line as postscript code or comment, given the start of the innermost block containing the line. Returns an integer, the column to indent to." (if containing-sexp (save-excursion (let ((indent-point (point))) (goto-char containing-sexp) ;; Is line first statement after an open-brace? (or ;; If no, find that first statement and indent like it. (save-excursion (forward-char 1) (while (progn (skip-chars-forward " \t\n") (looking-at comment-start-skip)) (forward-line 1)) (and (< (point) indent-point) (current-column))) ;; If no previous statement, ;; indent it relative to line brace is on. ;; For open brace in column zero, don't let statement ;; start there too. If ps-brace-indent is zero, ;; use ps-brace-offset instead. ;; Changes to the indentation of the next lines, ;; because of the contents of this one: (+ (if (= (following-char) ?\[) ps-bracket-indent (if (zerop ps-brace-indent) (if (bolp) ps-brace-offset 0) ps-brace-indent)) ;; Move back over whitespace before the openbrace. ;; If openbrace is not first nonwhite thing on the line, ;; add the ps-brace-imaginary-offset. (if (save-excursion (skip-chars-backward " \t") (bolp)) 0 ps-brace-imaginary-offset) (current-indentation))))) 0)) ;; For compatibility with all other modes, ;; I hope (like in all other modes, at the corresponding function) ;; that the point is not inside a string already, on the call to this defun. (defun ps-indent-exp (&optional reach-eob fixed-comments indent-newline) "Indent each line of the postscript grouping following point. If REACH-EOB is not nil, then all lines up to the end of buffer are indented, starting from the line with point in it (including this line). But if it is nil, all the line with point in it does not change indentation and all lines up to the end of the grouping starting at this line are indented. If FIXED-COMMENTS is not nil, then the comments at the end of the lines that follow statements in that line (and are not in a line by themselves) will not be indented to the comment-column, but will just be left at their position in the line , and if INDENT-NEWLINE is not nil, all blank lines will be indented up to the indentation level too. The argument REACH-EOB, except from nil and t can be a state as returned by ps-parse-partial-sexp, in which case point is already at the beginning of its line, and REACH-EOB is the parsing state at this point. The indentation in that case goes up to the end of the buffer. No point in the buffer can be on a negative depth related to the beginning of the buffer." (interactive "*") (let ((noerr (null reach-eob)) last-depth indent-stack omit goon noparse state next-depth beg indent) (save-excursion (if reach-eob (progn ;; When an argument is given, the line with point can change ;; indentation, too, so I have to use an initial state (if (eq reach-eob t) (progn (beginning-of-line) (setq state (ps-parse-partial-sexp (point-min) (point)))) (setq state reach-eob)) (while (and (nth 3 state) (null (eobp))) ;; No indentation changes: inside a string !!! get out of it. (setq state (ps-parse-partial-sexp (point) (progn (forward-line 1) (point)) nil nil state))) (setq last-depth (car state) indent-stack (make-list (1+ last-depth) nil))) ;; Do not test for complete sexp, using: ;; (save-excursion (forward-sexp 1)) (setq last-depth 0 omit t)) ;; If INDENT-NEWLINE is not nil, all empty lines in the region are ;; indented, but not any lines after the region. ;; If INDENT-NEWLINE and REACH-EOB are both not nil but the region ;; to be indented is empty, [when TAB was called on an empty line] ;; the indentation will be added at the end of the region, so that ;; the line will have the correct indentation: (setq goon (or (null (eobp)) (and reach-eob indent-newline))) (while goon (if omit (setq omit nil) (setq beg (point)) (skip-chars-forward " \t") (if (and (eolp) (null indent-newline)) (progn ;; delete any blanks (optional code). (if (null (eq beg (point))) (delete-region beg (point))) (setq noparse t)) (if (/= (current-column) (setq indent (or (and (setq noparse (looking-at comment-start-skip)) (cond ((bolp) 0) ((looking-at ps-comment-at-bol) 0) ((looking-at ps-comment-ok-pos) (current-column)) ((= (current-column) comment-column) comment-column) (t nil))) (+ (cond ((= (following-char) ?\]) (- ps-bracket-indent)) ((= (following-char) ?\}) (- ps-brace-indent)) ((= (following-char) ?\{) (if (bolp) 0 ps-brace-offset)) (t 0)) (or (car indent-stack) (setcar indent-stack (ps-calculate-indent (car (nth 7 state))))))))) (progn (delete-region beg (point)) (indent-to indent))))) (if noparse ;; this line is empty or a comment, so don't parse it. (progn (forward-line 1) (if (eobp) (setq goon nil) (setq noparse nil))) ;; Compute how depth changes over this line ;; plus enough other lines to get to one that ;; does not end inside a string. (while (if (progn (setq state (ps-parse-partial-sexp (point) (progn (end-of-line) (point)) nil nil state noerr)) (and (null (eobp)) (or reach-eob (> (car state) 0)))) (progn ;; If this line had ..} {.. in it, pop out of the levels ;; that ended anywhere in this line, even if the final ;; depth doesn't indicate that they ended. (setq next-depth (nth 6 state)) (while (> last-depth next-depth) (setq indent-stack (cdr indent-stack) last-depth (1- last-depth))) ;; Add levels for any parens started in this line. (setq next-depth (car state)) (while (< last-depth next-depth) (setq indent-stack (cons nil indent-stack) last-depth (1+ last-depth))) (nth 3 state)) (setq goon nil)) (forward-char 1)) (if (nth 4 state) (progn (if fixed-comments ;; don't indent the comment occupying half line. nil (indent-for-comment) ;; correct comment on the line (after the code) ;; and mark "no comment" for the next state. (end-of-line)) (setcar (nthcdr 4 state) nil))) (if goon (progn (forward-char 1) (if (eobp) (setq goon nil))))))))) ;;; Compilation functions: (defun ps-check-region (start end &optional arg) "Send the region to the ps-check-command, and wait for its execution. Using an argument, send the whole buffer. Each time a new process is used, so the system is memoryless." (interactive "r\nP") (let (command buffer) (setq command ps-check-command) (while (and command (symbolp command)) (setq command (if (fboundp command) (funcall command) (eval command)))) (if (or (null command) (string-equal command "")) (error "No checking command defined (ps-ckeck-command).")) ;; for convinient interactive use: (if arg (setq start (point-min) end (point-max))) (if (eq (setq buffer (get-buffer-create "*PS Output*")) (current-buffer)) (error "Do not call ps-check-region from the *PS Output* buffer.")) (save-excursion (set-buffer buffer) (erase-buffer)) (call-process-region start end shell-file-name nil buffer nil "-c" command) (if (save-excursion (set-buffer buffer) (> (buffer-size) 0)) (set-window-start (display-buffer buffer) 1) (message "(PS completed with no output)")))) ;;; The ps-shell functions: ;; Use cd (some commands need to be in the correct directory) ;; and absolute path name (in case the command is executed remotely, ;; and the path should start form the root ...) (defun ps-file (file-name) "Run postscript on the file given, on the *ps-shell* subshell. In this way you can see the output of other files, without even visiting them. The command that will be used is specified by the variable ps-shell-command." (interactive "f") (let (directory command done) (setq file-name (expand-file-name file-name) directory (file-name-as-directory (file-name-directory file-name))) (if (null (file-directory-p directory)) (error "%s is not a directory" directory)) (setq command ps-shell-command) (while (and command (symbolp command)) (setq command (if (setq done (fboundp command)) (funcall command file-name) (eval command)))) (if command nil (setq command inferior-ps-program done nil) (while (and command (symbolp command)) (setq command (if (fboundp command) (funcall command) (eval command))))) (if command nil (error "No command for running postscript (set the ps-shell-command).")) (if done nil (setq command (if (string-match "%s" command) (format command file-name) (concat command " " file-name)))) (save-excursion (if (get-buffer "*ps-shell*") (progn (set-buffer "*ps-shell*") (ps-kill-job)) (require 'shell) (set-buffer (make-shell "ps-shell" nil nil "-v")) ;; shell-mode, with more bindings. (setq ps-shell-map (copy-keymap shell-mode-map)) (ps-mode-common-shell-keys ps-shell-map) (use-local-map ps-shell-map) (if (zerop (buffer-size)) (sleep-for 1))) (if (string-equal directory default-directory) nil (setq default-directory directory) (send-string "ps-shell" (concat ps-shell-cd-command " " directory "\n"))) (send-string "ps-shell" (concat command "\n"))) (ps-recenter-output-buffer 0))) (defun ps-buffer () "Save the current buffer and run postscript on its file. See \\[ps-file] for more information. If you want to use a temporary file, use mark-whole-buffer and \\[ps-region]." (interactive) (save-buffer) (ps-file buffer-file-name)) (defun ps-region (beg end) "Run postscript on the current region. A temporary file (ps-zap-file) is written in directory ps-directory, and postscript is run in that directory. If the buffer has a header, it is written to the temporary file before the region itself. See also \\[ps-mark-prolog] and \\[ps-file]." (interactive "r") (if ps-zap-file nil (setq ps-zap-file (concat (make-temp-name "#tz") ".ps"))) (save-excursion (let ((directory default-directory)) (setq default-directory ps-directory) (if (ps-mark-prolog t) (progn (write-region (point) (mark) ps-zap-file nil) (write-region (max beg (mark)) end ps-zap-file t)) (write-region beg end ps-zap-file nil)) ;; make sure it ends in a newline (the next lines are very UGLY CODE) (if (/= (char-after (1- end)) ?\n) (progn (goto-char (point-min)) (if (search-forward "\n" nil t) (write-region (1- (point)) (point) ps-zap-file t)))) (ps-file ps-zap-file) (setq default-directory directory)))) (defun ps-page (&optional arg) "Run postscript on the current page (using a temporary file). The buffer's header is included too. See \\[ps-region] for more details. A numeric arg specifies to move forward or backward by that many pages, thus marking a page other than the one point was originally in." (interactive "P") (save-excursion (mark-page arg) (ps-region (point) (mark)))) (defun ps-kill-job () "Kill the currently running postscript job." (interactive) (quit-process "ps-shell" t)) (defun ps-recenter-output-buffer (linenum) "Redisplay buffer *ps-shell* so that most recent output can be seen. The last line of the buffer is displayed on line LINE of the window, or centered if LINE is nil." (interactive "P") (let ((buffer (get-buffer "*ps-shell*")) (old-buffer (current-buffer))) (if (null buffer) (error "No *ps-shell* buffer")) (pop-to-buffer buffer) (bury-buffer buffer) (goto-char (point-max)) (recenter (if linenum (prefix-numeric-value linenum) (/ (window-height) 2))) (pop-to-buffer old-buffer) )) ;;; The inferior-ps functions (defun inferior-ps-mode () "Major mode for interacting with an inferior postscript process. Runs a postscript interpreter as a subprocess of Emacs, with postscript I/O through an Emacs buffer. The variable inferior-ps-program controls which postscript interpreter is run. The variable inferior-ps-prompt can customize this mode for different postscript interpreters. This mode combines shell-mode and ps-mode. All the bindings of the shell-mode are active, and all the bindings of the ps-mode that do not send output to other processes (like inferior-ps-process and the ps-shell) are also valid, for processing the postscript code. For more details on this mode see these two modes. Commands: DELETE converts tabs to spaces as it moves back. \\[ps-indent-line] indents for postscript; with argument, shifts rest of expression rigidly with the current line. \\[ps-indent-exp] does \\[ps-indent-line] on each line starting within the following expression. Paragraphs are separated only by blank lines. \\[shell-send-input] at end of buffer sends line as input. \\[shell-send-input] not at end copies rest of line to end and sends it. Entry to this mode calls the value of (in this order) shell-mode-hook, ps-mode-hook and inferior-ps-mode-hook if that values are non-nil, with no arguments. You can send text to the inferior postscript from other buffers using the functions process-send-region, process-send-string and \\[ps-send-buffer], \\[ps-send-defun] and \\[ps-send-region]." (interactive) (if inferior-ps-mode-map nil (setq inferior-ps-mode-map (copy-alist shell-mode-map)) (ps-mode-common-inferior-keys inferior-ps-mode-map)) (ps-mode-common-initialization) (use-local-map inferior-ps-mode-map) (make-local-variable 'last-input-start) (make-local-variable 'last-input-end) (setq major-mode 'inferior-ps-mode mode-name "Inferior ps" mode-line-process '(": %s") last-input-start (make-marker) last-input-end (make-marker)) (run-hooks 'shell-mode-hook 'ps-mode-hook 'inferior-ps-mode-hook)) (defun ps-run (&optional arg) "Run an inferior postscript process, input and output via buffer *ps*. The process is created automatically, when needed, by the other functions. With an argument, does not switch to that buffer." (interactive "P") (require 'shell) (let (buffer) (save-excursion (set-buffer (setq buffer (make-shell "ps" inferior-ps-program))) (inferior-ps-mode)) (or arg (switch-to-buffer buffer)))) (defun ps-send-region (beg end &optional display-flag) "Send the region to the postscript process made by \\[ps-run]. If no current postscript process exists, create one. With argument, force redisplay and scrolling of the *ps* buffer." (interactive "r\nP") (or (get-process "ps") (ps-run t)) (process-send-region "ps" beg end) (if (eq (char-after (1- end)) ?\n) nil (process-send-string "ps" "\n")) (if display-flag (let* ((process (get-process "ps")) (buffer (process-buffer process)) (w (or (get-buffer-window buffer) (display-buffer buffer))) (height (window-height w)) (end)) (save-excursion (set-buffer buffer) (setq end (point-max)) (while (progn (accept-process-output process) (goto-char (point-max)) (beginning-of-line) (or (= (point-max) end) (not (looking-at inferior-ps-prompt))))) (setq end (point-max)) (vertical-motion (- 4 height)) (set-window-start w (point))) (set-window-point w end)))) (defun ps-send-buffer (&optional display-flag) "Send the current buffer to the postscript process made by \\[ps-run]. If no current postscript process exists, create one. With argument, force redisplay and scrolling of the *ps* buffer." (interactive "P") (ps-send-region (point-min) (point-max) display-flag)) (defun ps-send-defun (&optional display-flag) "Send the current defun to the postscript process made by \\[ps-run]. If no current postscript process exists, create one. With argument, force redisplay and scrolling of the *ps* buffer." (interactive "P") (save-excursion (ps-mark-function t) (ps-send-region (point) (mark) display-flag))) (defun ps-send-defun-and-go () "Send the current defun to the inferior postscript, and switch to *ps* buffer." (interactive) (ps-send-defun nil) (switch-to-buffer "*ps*")) ;;; Completion and Help function: (defun ps-complete-symbol () "*Perform completion on postscript symbol preceding point. That symbol is compared against the symbols that exist and any additional characters determined by what is there are inserted. Only builtin (display) postscript symbols are considered." (interactive "*") (let* ((end (point)) (beg (save-excursion (forward-sexp -1) (while (= (preceding-char) ?%) (forward-char -1)) (point))) (pattern (buffer-substring beg end)) (completion (try-completion pattern ps-token-table))) (cond ((eq completion t)) ((null completion) (message "Can't find completion for \"%s\"" pattern) (ding)) ((string-equal pattern completion) (message "Making completion list...") (with-output-to-temp-buffer "*Help*" (display-completion-list (all-completions pattern ps-token-table))) (message "Making completion list...%s" "done")) (t (delete-region beg end) (insert completion))))) ;;; I hope to have all the operators here. (setq ps-token-table [ %!PS-Adobe- %%Creator:\ %%For:\ %%Title:\ %%CreationDate:\ %%Pages:\ %%DocumentFonts:\ %%BoundingBox:\ %%EndComments %%EndProlog %%Page:\ %%Trailer FontDirectory StandardEncoding VMerror abs add aload anchorsearch and arc arcn arct arcto array ashow astore atan awidthshow banddevice begin bind bytesavailable cachestatus ceiling charpath clear cleartomark clip clippath closefile closepath colorimage concat concatmatrix condition copy copypage cos count countdictstack countexecstack counttomark currentblackgeneration currentcacheparams currentcmykcolor currentcolorscreen currentcolortransfer currentcontext currentdash currentdict currentfile currentflat currentfont currentgray currentgstate currenthalftone currenthalftonephase currenthsbcolor currentlinecap currentlinejoin currentlinewidth currentmatrix currentmiterlimit currentobjectformat currentpacking currentpoint currentrgbcolor currentrusage currentscreen currentshared currentstrokeadjust currenttransfer currentundercolorremoval curveto cvi cvlit cvn cvr cvrs cvs cvx def defaultmatrix definefont defineusername deletefile detach deviceinfo dict dictfull dictstack dictstackoverflow dictstackunderflow div dtransform dup echo end eoclip eofill eoviewclip eq erasepage errordict exch exec execstack execstackoverflow executeonly exit exp false file filenameforall fileposition fill findfont flattenpath floor flush flushfile for forall fork framedevice ge get getinterval grestore grestoreall gsave gstate gt handleerror identmatrix idiv idtransform if ifelse image imagemask index ineofill infill initclip initgraphics initmatrix initviewclip instroke interrupt inueofill inufill inustroke invalidaccess invalidcontext invalidexit invalidfileaccess invalidfont invalidid invalidrestore invertmatrix ioerror itransform join known kshow le length limitcheck lineto ln load lock log loop lt makefont mark matrix maxlength mod monitor moveto mul ne neg newpath noaccess nocurrentpoint not notify null nulldevice or packedarray pathbbox pathforall pop print printobject prompt pstack put putinterval quit rand rangecheck rcheck rcurveto read readhexstring readline readonly readstring realtime rectviewclip renamefile renderbands repeat resetfile restore reversepath rlineto rmoveto roll rotate round rrand run save scale scalefont scheck search selectfont setbbox setblackgeneration setcachedevice setcachelimit setcacheparams setcharwidth setcmykcolor setcolorscreen setcolortransfer setdash setfileposition setflat setfont setgray setgstate sethalftone sethalftonephase sethsbcolor setlinecap setlinejoin setlinewidth setmatrix setmiterlimit setobjectformat setpacking setrgbcolor setscreen setshared setstrokeadjust settransfer setucacheparams setundercolorremoval show showpage sin sqrt srand stack stackoverflow stackunderflow start status stop stopped store string stringwidth stroke strokepath sub syntaxerror systemdict timeout token transform translate true truncate type typecheck uappend ucache ucachestatus ueofill ufill undef undefined undefinedfilename undefinedresult undefinefont unmatchedmark unregistered upath userdict usertime ustroke ustrokepath version viewclip viewclippath vmreclaim vmstatus wait wcheck where widthshow write writehexstring writeobject writestring wtranslation xcheck xor xshow xyshow yield yshow]) ;;; Possible future additions: ;;; Indent according to other context too (begin/end, gsave/grestore, ...). ;;; region-byte-to-hex region-hex-to-byte ps-fill-defun ps-split-defun ;;; ps-reindent-defun ps-reindent-region (fill & split) ;;; ps-page: don't move to bob, display and back!!!.