home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / modes / postscript.el.z / postscript.el
Encoding:
Text File  |  1998-05-21  |  12.2 KB  |  355 lines
  1. ;;; postscript.el --- major mode for editing PostScript programs
  2.  
  3. ;; Keywords: langauges
  4.  
  5. ;; This file is part of XEmacs.
  6.  
  7. ;; XEmacs is free software; you can redistribute it and/or modify it
  8. ;; under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; XEmacs is distributed in the hope that it will be useful, but
  13. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. ;; General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  19. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20. ;; Boston, MA 02111-1307, USA.
  21.  
  22. ;;; Synched up with: Not in FSF.
  23.  
  24. ;;
  25. ;; Author:    Chris Maio
  26. ;; Last edit:    4 Sep 1988
  27. ;; Includes patches from relph@presto.ig.com (John M. Relph) posted to
  28. ;; gnu.emacs.sources on 22 Nov 90 04:53:43 GMT.
  29. ;;
  30. ;; The following two statements, placed in your .emacs file or site-init.el,
  31. ;; will cause this file to be autoloaded, and postscript-mode invoked, when
  32. ;; visiting .ps or .cps files:
  33. ;;
  34. ;;    (autoload 'postscript-mode "postscript.el" "" t)
  35. ;;    (setq auto-mode-alist
  36. ;;          (cons '("\\.c?ps$".postscript-mode) auto-mode-alist))
  37. ;;
  38.  
  39. (provide 'postscript)
  40.  
  41. (defconst ps-indent-level 2
  42.   "*Indentation to be used inside of PostScript blocks or arrays")
  43.  
  44. (defconst ps-tab-width 8
  45.   "*Tab stop width for PostScript mode")
  46.  
  47. (defun ps-make-tabs (stop)
  48.   (and (< stop 132) (cons stop (ps-make-tabs (+ stop ps-tab-width)))))
  49.  
  50. (defconst ps-tab-stop-list (ps-make-tabs ps-tab-width)
  51.   "*Tab stop list for PostScript mode")
  52.  
  53. (defconst ps-postscript-command '("gs" "-")
  54.   "*Command used to invoke with a printer spooler or NeWS server.")
  55.  
  56. (defvar ps-mode-map nil
  57.   "Keymap used in PostScript mode buffers")
  58.  
  59. (defvar ps-mode-syntax-table nil
  60.   "PostScript mode syntax table")
  61.  
  62. (defvar ps-balanced-string-syntax-p
  63.   (let ((b (current-buffer))
  64.         (loser (generate-new-buffer "x")))
  65.     (unwind-protect
  66.          (progn
  67.            (set-buffer loser)
  68.            (set-syntax-table (copy-syntax-table))
  69.            (modify-syntax-entry ?\(  "\"\)")
  70.            (insert "((")
  71.            (let ((v (parse-partial-sexp (point-min) (point-max))))
  72.              (if (elt v 3)
  73.                  ;; New syntax code think's we're still inside a string
  74.                  t
  75.                  nil)))
  76.       (set-buffer b)
  77.       (kill-buffer loser))))
  78.  
  79. (defconst postscript-font-lock-keywords (purecopy
  80.    (list
  81.     ;; Proper rule for Postscript strings
  82.     '("(\\([^)]\\|\\\\.\\|\\\\\n\\)*)" . font-lock-string-face)
  83.     ;; Make any line beginning with a / be a ``keyword''
  84.     '("^/[^\n%]*" . font-lock-keyword-face)
  85.     ;; Make brackets of all forms be keywords
  86.     '("[][<>{}]+" . font-lock-keyword-face)
  87.     ;; Keywords
  88.     (list (concat 
  89.        "[][ \t\f\n\r()<>{}/%]"    ;delimiter
  90.        "\\("
  91.        (mapconcat 'identity
  92.               '("begin" "end" 
  93.             "save" "restore" "gsave" "grestore"
  94.             ;; Any delimited name ending in 'def'
  95.             "[a-zA-Z0-9-._]*def"
  96.             "[Dd]efine[a-zA-Z0-9-._]*")
  97.               "\\|")
  98.        "\\)"
  99.        "\\([][ \t\f\n\r()<>{}/%]\\|$\\)" ;delimiter
  100.        )
  101.       1 'font-lock-keyword-face)))
  102.    "Expressions to highlight in Postscript buffers.")
  103. (put 'postscript-mode 'font-lock-defaults '(postscript-font-lock-keywords))
  104.  
  105. (if ps-mode-syntax-table
  106.     nil
  107.   (let ((i 0))
  108.     (setq ps-mode-syntax-table (copy-syntax-table nil))
  109.     (while (< i 256)
  110.       (or (= (char-syntax i ps-mode-syntax-table) ?w)
  111.           (modify-syntax-entry i  "_"     ps-mode-syntax-table))
  112.       (setq i (1+ i)))
  113.     (modify-syntax-entry ?\   " "     ps-mode-syntax-table)
  114.     (modify-syntax-entry ?\t  " "     ps-mode-syntax-table)
  115.     (modify-syntax-entry ?\f  " "     ps-mode-syntax-table)
  116.     (modify-syntax-entry ?\r  " "     ps-mode-syntax-table)
  117.     (modify-syntax-entry ?\%  "<"     ps-mode-syntax-table)
  118.     (modify-syntax-entry ?\n  ">"     ps-mode-syntax-table)
  119.     (modify-syntax-entry ?\\  "\\"    ps-mode-syntax-table)
  120.     (modify-syntax-entry ??   "_"     ps-mode-syntax-table)
  121.     (modify-syntax-entry ?_   "_"     ps-mode-syntax-table)
  122.     (modify-syntax-entry ?.   "_"     ps-mode-syntax-table)
  123.     (modify-syntax-entry ?/   "'"     ps-mode-syntax-table)
  124.     (if ps-balanced-string-syntax-p
  125.         (progn
  126.           (modify-syntax-entry ?\(  "\"\)"  ps-mode-syntax-table)
  127.           (modify-syntax-entry ?\)  "\"\(" ps-mode-syntax-table))
  128.         (progn
  129.           ;; This isn't correct, but Emacs syntax stuff
  130.           ;;  has no way to deal with string syntax which uses
  131.           ;;  different open and close characters.  Sigh.
  132.           (modify-syntax-entry ?\(  "("     ps-mode-syntax-table)
  133.           (modify-syntax-entry ?\)  ")"     ps-mode-syntax-table)))
  134.     (modify-syntax-entry ?\[  "(\]"   ps-mode-syntax-table)
  135.     (modify-syntax-entry ?\]  ")\["   ps-mode-syntax-table)
  136.     (modify-syntax-entry ?\{  "\(\}"  ps-mode-syntax-table)
  137.     (modify-syntax-entry ?\}  "\)\}"  ps-mode-syntax-table)
  138.     (modify-syntax-entry ?/   "' p"   ps-mode-syntax-table)
  139.     ))
  140.  
  141.  
  142. ;;;###autoload
  143. (defun postscript-mode ()
  144.   "Major mode for editing PostScript files.
  145.  
  146. \\[ps-execute-buffer] will send the contents of the buffer to the NeWS
  147. server using psh(1).  \\[ps-execute-region] sends the current region.
  148. \\[ps-shell] starts an interactive psh(1) window which will be used for
  149. subsequent \\[ps-execute-buffer] or \\[ps-execute-region] commands.
  150.  
  151. In this mode, TAB and \\[indent-region] attempt to indent code
  152. based on the position of {}, [], and begin/end pairs.  The variable
  153. ps-indent-level controls the amount of indentation used inside
  154. arrays and begin/end pairs.  
  155.  
  156. \\{ps-mode-map}
  157.  
  158. \\[postscript-mode] calls the value of the variable postscript-mode-hook 
  159. with no args, if that value is non-nil."
  160.   (interactive)
  161.   (kill-all-local-variables)
  162.   (use-local-map ps-mode-map)
  163.   (set-syntax-table ps-mode-syntax-table)
  164.   (make-local-variable 'comment-start)
  165.   (setq comment-start "% ")
  166.   (make-local-variable 'comment-start-skip)
  167.   (setq comment-start-skip "%+ *")
  168.   (make-local-variable 'comment-column)
  169.   (setq comment-column 40)
  170.   (make-local-variable 'indent-line-function)
  171.   (setq indent-line-function 'ps-indent-line)
  172.   (make-local-variable 'tab-stop-list)
  173.   (setq tab-stop-list ps-tab-stop-list)
  174.   (make-local-variable 'page-delimiter)
  175.   (setq page-delimiter "^showpage")
  176.   (make-local-variable 'parse-sexp-ignore-comments)
  177.   (setq parse-sexp-ignore-comments t)
  178.   (setq mode-name "PostScript")
  179.   (setq major-mode 'postscript-mode)
  180.   (run-hooks 'ps-mode-hook) ; bad name!  Kept for compatibility.
  181.   (run-hooks 'postscript-mode-hook)
  182.   )
  183.  
  184. (defun ps-tab ()
  185.   "Command assigned to the TAB key in PostScript mode."
  186.   (interactive)
  187.   (if (save-excursion (skip-chars-backward " \t") (bolp))
  188.       (ps-indent-line)
  189.     (save-excursion
  190.       (ps-indent-line))))
  191.  
  192. (defun ps-indent-line ()
  193.   "Indents a line of PostScript code."
  194.   (interactive)
  195.   (beginning-of-line)
  196.   (delete-horizontal-space)
  197.   (if (not (or (looking-at "%%")    ; "%%" comments stay at left margin
  198.            (ps-top-level-p)))
  199.       (if (and (< (point) (point-max))
  200.            (eq ?\) (char-syntax (char-after (point)))))
  201.       (ps-indent-close)        ; indent close-delimiter
  202.     (if (looking-at "\\(dict\\|class\\)?end\\|cdef\\|grestore\\|>>")
  203.         (ps-indent-end)        ; indent end token
  204.       (ps-indent-in-block)))))    ; indent line after open delimiter
  205.   
  206. ;(defun ps-open ()
  207. ;  (interactive)
  208. ;  (insert last-command-char))
  209.  
  210. (defun ps-insert-d-char (arg)
  211.   "Awful hack to make \"end\" and \"cdef\" keywords indent themselves."
  212.   (interactive "p")
  213.   (insert-char last-command-char arg)
  214.   (save-excursion
  215.     (beginning-of-line)
  216.     (if (looking-at "^[ \t]*\\(\\(dict\\|class\\)?end\\|cdef\\|grestore\\)")
  217.     (progn
  218.       (delete-horizontal-space)
  219.       (ps-indent-end)))))
  220.  
  221. (defun ps-close ()
  222.   "Inserts and indents a close delimiter."
  223.   (interactive)
  224.   (insert last-command-char)
  225.   (backward-char 1)
  226.   (ps-indent-close)
  227.   (forward-char 1)
  228.   (blink-matching-open))
  229.  
  230. (defun ps-indent-close ()
  231.   "Internal function to indent a line containing a an array close delimiter."
  232.   (if (save-excursion (skip-chars-backward " \t") (bolp))
  233.       (let (x (oldpoint (point)))
  234.     (forward-char) (backward-sexp)    ;XXX
  235.     (if (and (eq 1 (count-lines (point) oldpoint))
  236.          (> 1 (- oldpoint (point))))
  237.         (goto-char oldpoint)
  238.       (beginning-of-line)
  239.       (skip-chars-forward " \t")
  240.       (setq x (current-column))
  241.       (goto-char oldpoint)
  242.       (delete-horizontal-space)
  243.       (indent-to x)))))
  244.  
  245. (defun ps-indent-end ()
  246.   "Indent an \"end\" token or array close delimiter."
  247.   (let ((goal (ps-block-start)))
  248.     (if (not goal)
  249.     (indent-relative)
  250.       (setq goal (save-excursion
  251.            (goto-char goal) (back-to-indentation) (current-column)))
  252.       (indent-to goal))))
  253.  
  254. (defun ps-indent-in-block ()
  255.   "Indent a line which does not open or close a block."
  256.   (let ((goal (ps-block-start)))
  257.     (setq goal (save-excursion
  258.          (goto-char goal)
  259.          (back-to-indentation)
  260.          (if (bolp)
  261.              ps-indent-level
  262.            (back-to-indentation)
  263.            (+ (current-column) ps-indent-level))))
  264.     (indent-to goal)))
  265.  
  266. ;;; returns nil if at top-level, or char pos of beginning of current block
  267. (defun ps-block-start ()
  268.   "Returns the character position of the character following the nearest
  269. enclosing `[' `{' or `begin' keyword."
  270.   (save-excursion
  271.     (let ((open (condition-case nil
  272.                     (save-excursion
  273.                       (backward-up-list 1)
  274.                       (1+ (point)))
  275.                   (error nil))))
  276.       (ps-begin-end-hack open))))
  277.  
  278. (defun ps-begin-end-hack (start)
  279.   "Search backwards from point to START for enclosing `begin' and returns the
  280. character number of the character following `begin' or START if not found."
  281.   (save-excursion
  282.     (let ((depth 1))
  283.       (while (and (> depth 0)
  284.           (or (re-search-backward "^[ \t]*\\(dict\\|class\\)?\\(end\\|grestore\\|>>\\)\\|\\(begin\\|gsave\\|<<\\)[ \t]*\\(%.*\\)*$"
  285.                                           start t)
  286.               (re-search-backward "^[ \t]*cdef.*$" start t)))
  287.      (setq depth (if (looking-at "[ \t]*\\(dict\\|class\\)?\\(end\\|grestore\\|>>\\)")
  288.             (1+ depth) (1- depth))))
  289.       (if (not (eq 0 depth))
  290.       start
  291.     (forward-word 1)
  292.     (point)))))
  293.  
  294. (defun ps-top-level-p ()
  295.   "Awful test to see whether we are inside some sort of PostScript block."
  296.   (and (condition-case nil
  297.        (not (scan-lists (point) -1 1))
  298.      (error t))
  299.        (not (ps-begin-end-hack nil))))
  300.  
  301. ;;; initialize the keymap if it doesn't already exist
  302. (if (null ps-mode-map)
  303.     (progn
  304.       (setq ps-mode-map (make-sparse-keymap))
  305.       (set-keymap-name ps-mode-map 'ps-mode-map)
  306.       ;;(define-key ps-mode-map "d" 'ps-insert-d-char)
  307.       ;;(define-key ps-mode-map "f" 'ps-insert-d-char)
  308.       ;;(define-key ps-mode-map "{" 'ps-open)
  309.       ;;(define-key ps-mode-map "}" 'ps-close)
  310.       ;;(define-key ps-mode-map "[" 'ps-open)
  311.       ;;(define-key ps-mode-map "]" 'ps-close)
  312.       (define-key ps-mode-map "\t" 'ps-tab)
  313.       (define-key ps-mode-map "\C-c\C-c" 'ps-execute-buffer)
  314.       (define-key ps-mode-map "\C-c|" 'ps-execute-region)
  315.       ;; make up yout mind! -- the below or the above?
  316.       (define-key ps-mode-map "\C-c!" 'ps-shell)
  317.       ))
  318.  
  319. (defun ps-execute-buffer ()
  320.   "Send the contents of the buffer to a printer or NeWS server."
  321.   (interactive)
  322.   (save-excursion
  323.     (mark-whole-buffer)
  324.     (ps-execute-region (point-min) (point-max))))
  325.  
  326. (defun ps-execute-region (start end)
  327.   "Send the region between START and END to a printer or NeWS server.
  328. You should kill any existing *PostScript* buffer unless you want the
  329. PostScript text to be executed in that process."
  330.   (interactive "r")
  331.   (let ((start (min (point) (mark)))
  332.     (end (max (point) (mark))))
  333.     (condition-case nil
  334.     (process-send-string "PostScript" (buffer-substring start end))
  335.       (error (shell-command-on-region 
  336.               start end
  337.               (mapconcat 'identity ps-postscript-command " ")
  338.               nil)))))
  339.  
  340. (defun ps-shell ()
  341.   "Start a shell communicating with a PostScript printer or NeWS server."
  342.   (interactive)
  343.   (require 'shell)
  344.   (switch-to-buffer-other-window
  345.     (apply 'make-comint
  346.            "PostScript"
  347.            (car ps-postscript-command)
  348.            nil
  349.            (cdr ps-postscript-command)))
  350.   (make-local-variable 'shell-prompt-pattern)
  351. ; (setq shell-prompt-pattern "PS>")
  352.   (setq shell-prompt-pattern "GS>")
  353. ; (process-send-string "PostScript" "executive\n")
  354.   )
  355.