[comp.emacs] Scribe Mode

spe@cad.cs.cmu.edu (Sean Engelson) (01/20/87)

Keywords:


Following is a Scribe mode that I wrote, it does all kinds of nice
things, just do a describe-function on scribe-mode to find out what
they are.  All comments are welcome, further versions (if any) will be
posted.


;; Copyright (c) 1986 Sean Philip Engelson
;; All GNU Emacs copyright restrictions and permissions apply

;; Some parts of this file are modified from tex-mode.el in the
;; GNU Emacs v18+ distribution, those portions are
;; Copyright (C) 1985 Richard M. Stallman
;; Rewritten following contributions by William F. Schelter
;; and Dick King (king@kestrel).

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.


(defvar scribe-mode-syntax-table nil
  "Syntax table used while in scribe mode.")
(defvar scribe-mode-hook nil
  "Function (if any) to be called on invocation of scribe mode.")

(defvar scribe-zap-file nil
  "Temporary file name used for text being sent as input to scribe.")
(defvar scribe-command "cd /tmp; scribe"
  "The command to run scribe on a file in /tmp, to make output in /tmp.")
(defvar scribe-press-print-command "cz"
  "Command string used to print a .press file.")
(defvar scribe-trailer "\n"
  "Scribe input supplied after the end of a region sent to scribe by M-x scribe-region.")
(defvar scribe-big-env-region-size 150
  "Size to use @begin and @end for region environments")
(defvar scribe-open-paren "[\\[({<\"'`]"
  "Regular expression that matches a valid scribe open paren")
(defvar scribe-close-paren "[])}>\"']"
  "Regular expression that matches a valid scribe close paren")
(defvar scribe-default-open "{"
  "Default open paren for scribe commands")
(defvar scribe-default-close "}"
  "Default close paren for scribe commands")



(defvar scribe-mode-map nil)
(if scribe-mode-map 
    nil
  (setq scribe-mode-map (make-sparse-keymap))
  (define-key scribe-mode-map "\C-j" 'scribe-terminate-paragraph)
  (define-key scribe-mode-map "\C-ce" 'scribe-environment-block)
  (define-key scribe-mode-map "\C-cr" 'scribe-region)
  (define-key scribe-mode-map "\C-cs" 'scribe-buffer)
  (define-key scribe-mode-map "\C-cp" 'scribe-print)
  (define-key scribe-mode-map "\C-c\C-f" 'forward-scribe-command)
  (define-key scribe-mode-map "\C-c\C-b" 'backward-scribe-command)
  (define-key scribe-mode-map "\C-c\C-a" 'beginning-of-scribe-env)
  (define-key scribe-mode-map "\C-c\C-e" 'end-of-scribe-env)
  (define-key scribe-mode-map "\e(" 'parenthesize-word)
  (define-key scribe-mode-map "\C-cw" 'scribe-env-wrap-line)
  (define-key scribe-mode-map "\C-c\C-w" 'scribe-env-wrap-region)
  (define-key scribe-mode-map "\C-cb" 'scribe-boldface-word)
  (define-key scribe-mode-map "\C-ci" 'scribe-italicize-word)
  (define-key scribe-mode-map "\C-cu" 'scribe-underline-word)
  (define-key scribe-mode-map "\C-c\C-c" (global-key-binding "\C-c")))



(defun validate-scribe-buffer ()
  "Check current buffer for paragraphs containing mismatched parens.
As each such paragraph is found, a mark is pushed at its beginning,
and the location is displayed for a few seconds.  Mismatched @begin/@end
pairs are also detected and displayed."
  (interactive)
  (let ((opoint (point)))
    (if (eq (forward-scribe-begin-end (point)) 'error)
	(sit-for 4))
    (goto-char (point-max))
    ;; Does not use save-excursion
    ;; because we do not want to save the mark.
    (unwind-protect
	(while (and (not (input-pending-p)) (not (bobp)))
	  (let ((end (point)))
	    (search-backward "\n\n" nil 'move)
	    (or (scribe-validate-paragraph (point) end)
		(progn
		  (push-mark (point))
		  (message "Mismatch found in pararaph starting here")
		  (sit-for 4)))))
      (goto-char opoint))))

(defun scribe-validate-paragraph (start end)
  (condition-case ()
      (save-excursion
	(save-restriction
	  (narrow-to-region start end)
	  (goto-char start)
	  (forward-sexp (- end start))
	  t))
    (error nil)))

(defun scribe-terminate-paragraph (inhibit-validation)
  "Insert two newlines, breaking a paragraph for scribe.
Check for mismatched parens in paragraph being terminated.
A prefix arg inhibits the checking."
  (interactive "P")
  (or inhibit-validation
      (scribe-validate-paragraph
       (save-excursion
	 (search-backward "\n\n" nil 'move)
	 (point))
       (point))
      (message "Paragraph being closed appears to contain a mismatch"))
  (insert "\n\n"))


;; Invoking scribe in an inferior shell.

(defun scribe-region (beg end)
  "Run scribe on current region.  Optionally process buffer's header
first.  The buffer's header is everything up to a line saying
\"@comment(end of header)\".  It is processed as input by scribe
before the region itself.  The file has a header if one of the first
ten lines says \"@comment(start of header)\".  The value of
scribe-trailer is supplied as input to scribe after the region.  It
defaults to \"\\n\"."
  (interactive "r")
  (or (get-buffer "*scribe-shell*")
      (progn
	(require 'shell)
	(make-shell "scribe-shell" "csh")))
  (or scribe-zap-file (setq scribe-zap-file (make-temp-name "/tmp/tz")))
  (let ((scribe-out-file (concat scribe-zap-file ".mss")))
    (save-excursion
      (goto-char (point-min))
      (forward-line 10)
      (let ((search-end (point))
	    hbeg)
	(goto-char (point-min))
	;; Initialize the temp file with either the header or nothing
	(if (and (search-forward "@comment(start of header)" search-end t)
		 (< (point) beg))
	    (progn
	      (forward-line 1)
	      (setq hbeg (point))
	      (search-forward "@comment(end of header)")
	      (beginning-of-line)
	      (write-region hbeg (point) scribe-out-file))
	  (write-region (point) (point) scribe-out-file))
	;; Append the region to be printed.
	(write-region beg end scribe-out-file t)))
    (send-string "scribe-shell" (concat scribe-command " " scribe-out-file "\n")))
  (if scribe-trailer
      (send-string "scribe-shell" scribe-trailer))
  (pop-to-buffer "*scribe-shell*"))

(defun scribe-buffer ()
  "Run scribe on current buffer."
  (interactive)
  (let (scribe-trailer)
    (scribe-region (point-min) (point-max))))

(defun scribe-print ()
  "Print the .press file made by \\[scribe-region] or \\[scribe-buffer]."
  (interactive)
  (send-string "scribe-shell"
	       (concat scribe-press-print-command " " scribe-zap-file ".press\n")))




(defun scribe-environment-block (env)
  "Create a @begin()/@end() environment block"
  (interactive "sEnvironment: ")
  (insert "@begin(" env ")\n")
  (save-excursion
    (insert "\n@end(" (substring env 0 (string-match "," env)) ")\n")))



(defun forward-scribe-command (count)
  "Go forward to the next Scribe command in the buffer.  With prefix arg,
go forward that many commands."
  (interactive "p")
  (forward-char)
  (if (> count 0)
      (progn
       (re-search-forward "@[^@]" nil nil count)
       (backward-char 2))
    (re-search-backward "@[^@]" nil nil (- count))))

(defun backward-scribe-command (count)
  "Go backward to the next Scribe command in the buffer.  With prefix arg,
go backward that many commands."
  (interactive "p")
  (forward-scribe-command (- count)))



(defun scribe-insert-parens ()
  "Make a pair of default parens and be poised to type inside of them."
  (interactive)
  (insert scribe-default-open)
  (save-excursion
    (insert scribe-default-close)))
    
(defun parenthesize-region (beg end)
  "Put regular parens () around the current region."
  (interactive "r")
  (save-excursion
    (goto-char beg)
    (insert "(")
    (goto-char end)
    (insert ")")))

(defun parenthesize-line (point)
  "Put regular parens () around the current line."
  (interactive "d")
  (save-excursion
    (goto-char point)
    (beginning-of-line)
    (let ((b (point)))
      (end-of-line)
      (forward-char)
      (parenthesize-region b (point)))))

(defun parenthesize-word (point)
  "Put regular parens () around the current word.  With a prefix arg, 
parenthesize that many words."
  (interactive "d")
  (save-excursion
    (goto-char point)
    (forward-char)
    (forward-word -1)
    (let ((b (point)))
      (forward-word 1)
      (forward-char)
      (parenthesize-region b (point)))))



(defun scribe-env-wrap-region (beg end env)
  "Wrap an environment around a region.  If the region is bigger than
SCRIBE-BIG-ENV-REGION-SIZE, use @begin and @end to delimit the environment."
  (interactive "r\nsEnvironment: ")
  (if (> (- end beg) scribe-big-env-region-size)
      (save-excursion
	(goto-char end)
	(insert "@end(" (substring env 0 (string-match "," env)) ")")
	(goto-char beg)
	(insert "@begin(" env ")\n"))
    (save-excursion
      (goto-char end)
      (insert scribe-default-close)
      (goto-char beg)
      (insert "@" env scribe-default-open))))

(defun scribe-env-wrap-line (env)
  "Wrap a scribe environment around the current line."
  (interactive "sEnvironment: ")
  (save-excursion
    (beginning-of-line)
    (insert "@" env scribe-default-open)
    (end-of-line)
    (insert scribe-default-close)))

(defun scribe-env-wrap-word (env count)
  "Wrap a scribe environment around the current word.  With prefix arg, wrap
that many words forward or backward."
  (interactive "sEnvironment: \np")
  (save-excursion
    (forward-char 1)
    (if (< count 0)
	(forward-word count)
      (forward-word -1))
    (insert "@" env scribe-default-open)
    (if (> count 0)
	(forward-word count)
      (forward-word (- count)))
    (insert scribe-default-close)))



(defun scribe-italicize-word (count)
  "Italicize a word.  With prefix arg, italicize that many words."
  (interactive "p")
  (scribe-env-wrap-word "i" count))

(defun scribe-boldface-word (count)
  "Boldface a word.  With prefix arg, boldface that many words."
  (interactive "p")
  (scribe-env-wrap-word "b" count))

(defun scribe-underline-word (count)
  "Underline a word.  With prefix arg, underline that many words."
  (interactive "p")
  (scribe-env-wrap-word "ux" count))



(defun beginning-of-scribe-env (count)
  "Go to the beginning of the current scribe environment, if it exists."
  (interactive "p")
  (if (not (re-search-backward "@begin" nil t count))
      (message "No environment block found")))

(defun end-of-scribe-env (count)
  "Go to the end of the current scribe environment, if it exists."
  (interactive "p")
  (if (re-search-forward "@end" nil t count)
      (forward-sexp)
    (message "No environment block found")))
  
    



(defun forward-scribe-begin-end (point)
  (interactive "d")
  (goto-char point)
    (let (env-name)
      (if (re-search-forward "\\(@begin\\)\\|\\(@end\\)" nil t 1)
	  (if (string= (last-word) "begin")
	      (progn
		(forward-char 1)
		(let ((p (point)))
		  (forward-word 1)
		  (setq env-name (buffer-substring p (point))))
		(if (eq (forward-scribe-begin-end (point)) 'error)
		    'error
		  (if (and (re-search-forward (concat "@end" scribe-open-paren)
					      nil t 1)
			   (string= (next-word) env-name))
		      (progn
			(forward-char 1)
			t)
		    (progn
		      (beep)
		      (message "@begin/@end matching error with env '%s'"
			       env-name)
		      'error))))
	    (progn
	      (goto-char point)  ; original starting point
	      nil))
	  nil)))

(defun last-word ()
  (save-excursion
    (let ((p (point)))
      (forward-word -1)
      (buffer-substring (point) p))))

(defun next-word ()
  (save-excursion
    (let ((p (point)))
      (forward-word 1)
      (buffer-substring p (point)))))



(defun scribe-mode ()
  "Major mode for editing files of input for scribe.

), ], >, }, and \" display the characters they match.  Use
\\[validate-scribe-buffer] to check buffer for paragraphs containing
mismatched ()'s, []'s, {}'s, or <>'s.

Use \\[parenthesize-region] and \\[parenthesize-line] to wrap parentheses
around the region and line, respectively.  Use \\[parenthesize-word]
to parenthesize a word.

Use \\[scribe-environment-block] to create a @begin() @end()
environment block.  Use \\[environment-wrap-line] and
\\[environment-wrap-region] to wrap environments around the line and
the region, respectively.

Use \\[scribe-region] to run scribe on the current region, plus a
\"header\" copied from the top of the file (containing macro
definitions, etc.), running scribe under a special subshell.
\\[scribe-buffer] does the whole buffer.  \\[scribe-print] prints the
.press file made by either of those.

Full list of special commands:
\\{scribe-mode-map}

Entering scribe mode calls the value of text-mode-hook,
and then the value of scribe-mode-hook."
  (interactive)
  (kill-all-local-variables)
  (use-local-map scribe-mode-map)
  (setq mode-name "Scribe")
  (setq major-mode 'scribe-mode)
  (setq local-abbrev-table text-mode-abbrev-table)
  (if (null scribe-mode-syntax-table)
      (progn
	(setq scribe-mode-syntax-table (make-syntax-table))
	(set-syntax-table scribe-mode-syntax-table)
	(modify-syntax-entry ?\\ "\\   ")
	(modify-syntax-entry ?\[ "(]  ")
	(modify-syntax-entry ?\] ")[  ")
	(modify-syntax-entry ?\< "(>  ")
	(modify-syntax-entry ?\> ")<  ")
	(modify-syntax-entry ?\{ "(}  ")
	(modify-syntax-entry ?\} "){  ")
	(modify-syntax-entry ?\" "$$  ")
	(modify-syntax-entry ?' "w   "))
    (set-syntax-table scribe-mode-syntax-table))
  (make-local-variable 'paragraph-start)
  (setq paragraph-start "^\n")
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate paragraph-start)
  (if text-mode-hook (funcall text-mode-hook))
  (if scribe-mode-hook (funcall scribe-mode-hook)))

(setq auto-mode-alist		;tell the editor about scribe mode
      (cons '("\\.mss$" . scribe-mode)
	    auto-mode-alist))

-- 
----------------------------------------------------------------------
I have no opinions.  Therefore my employer is mine.
----------------------------------------------------------------------
Sean Philip Engelson			+---------------+
Carnegie-Mellon University		| POST NO BILLS |
Computer Science Department		+---------------+
----------------------------------------------------------------------
ARPA: spe@cad.cs.cmu.edu
UUCP: {harvard | seismo | ucbvax}!cad.cs.cmu.edu!spe
----------------------------------------------------------------------