cgit.sxemacs.org Git - packages/blob - xemacs-packages/prog-modes/postscript.el

   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     '("(\\([^)]*\\))" . 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
 356 ;; XEmacs addition
 357 ;;;###autoload(add-to-list 'auto-mode-alist '("\\.c?ps\\'" . postscript-mode))