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