⟦189164009⟧

TextFile

;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Emacs-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;
;; template.el --- Essentially a bnf processor/language-sensitive editor.
;; Author          : Unknown, enhanced by Lynn Slater
;; Created On      : Fri Jun 10 10:20:00 1988
;; Last Modified By: Lynn Slater
;; Last Modified On: Tue Oct 18 06:57:01 1988
;; Update Count    : 2
;; Status          : General Public Release 1.05
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Make this ~/el/template.el

;; This is essentially a bnf processor/language-sensitive editor.  The
;; next message will give you an ada bnf file that you can use within
;; ada-mode to expand nonterminals.  But you can role your own
;; grammars (e.g., your design grammar or an ADL) and put them in
;; *.bnf files ..


;;; The BNF rule set is stored as a list of rules.  Each rule is
;;; of the form
;;; (NONTERMINAL (ALTERNATIVES ....))
;;; where each ALTERNATIVE is a list of lines representing the 
;;; construct the NONTERMINAL expands into.

(provide 'template)

(defvar bnf-token-start "{")

(defvar bnf-token-end "}")

(defvar bnf-rule-separator "^\^l"
  "String separating BNF rules.  Each separator string must be on its
own line.")

(defvar bnf-rule-assignment-operator "::=")

(defvar bnf-rule-alternative-separator "|")

(defvar bnf-rule-empty-line "{empty-line}")

(defvar template-alternatives)
(defvar all-templates () ;; lrs
  "Alist of token and alternative. Is good for prompting") 
  
(defconst whitespace "[ \t]*")

(defconst non-whitespace-char "[^ \t]")

(defun bnf-mode nil
  "Major mode for dealing with BNF for the template editor."
  (interactive)
  (setq major-mode 'bnf-mode)
  (setq mode-name "BNF")
  (make-local-variable 'comment-column)
  (setq comment-column 1)
  (make-local-variable 'comment-start)
  (setq comment-start "--")
  (make-local-variable 'comment-end)
  (setq comment-end ""))

(defun next-bnf-line nil
  (next-line 1)
  (beginning-of-line)
  (while (or (looking-at (concat "^" comment-start))
	     (looking-at (concat "^" whitespace "\n"))
	     )
    (next-line 1)
    (beginning-of-line)))

(defun get-next-bnf-rule  nil
  (interactive)
  (beginning-of-line)
  (let* ((nonterminal (get-nonterminal))
	 (alternatives (get-list-of-alternatives)))
    (list nonterminal alternatives)))

(defun scan-to-next-rule-separator nil
  (beginning-of-line)
  (while (not (or (eobp)
		  (looking-at bnf-rule-separator)))
    (next-bnf-line)))


(defun get-nonterminal nil
  (let ((nonterminal (get-bnf-token)))
    (if (looking-at (concat whitespace bnf-rule-assignment-operator
			    whitespace "$"))
	(progn
	  (next-bnf-line)
	  nonterminal)
      (progn
	(scan-to-next-rule-separator)
	(error (concat "Cannot find " bnf-rule-assignment-operator
		       " after " nonterminal))))))
      
(defun get-bnf-token nil
  (interactive)
  (if (looking-at bnf-token-start)
      (let ((start-pos (dot)))
	(re-search-forward bnf-token-end)
	(let ((token (buffer-substring start-pos (dot))))
	  (if (string-equal token bnf-rule-empty-line)
	      (buffer-substring (save-excursion (beginning-of-line)) (1- start-pos))
	      token)))
    (progn
      (scan-to-next-rule-separator)
      (error "Could not find start of token"))))


(defun get-list-of-alternatives nil
  (beginning-of-line)
  (if (or (eobp) (looking-at bnf-rule-separator))
      nil
      (cons (get-alternative) (get-list-of-alternatives))))

(defun get-alternative nil
  (let ((done nil)
	(alternative nil))
    (while (not done)
      (if (or (eobp) (looking-at bnf-rule-separator))
	  (setq done t)
	(let ((start-pos (dot)))
	  (end-of-line)
	  (re-search-backward (concat non-whitespace-char whitespace))
	  (if (looking-at bnf-rule-alternative-separator)
	      (progn
		(re-search-backward (concat non-whitespace-char whitespace))
		(forward-char 1)
		(setq done t))
	    (forward-char 1))
	  (setq alternative
		(append alternative
			(list (buffer-substring start-pos (dot)))))
	  (next-bnf-line))))
    alternative))

(defun parse-next-bnf-rule  nil		; assumes you are in BNF mode,
  (interactive)				; and that you are at the start
  (let* ((rule (get-next-bnf-rule))	; of the next rule
	 (name (substring (car rule) 1 (1- (length (car rule)))))
	 (symbol (intern (car rule)))
	 (alternatives (car (cdr rule))))
    (if (not (assoc name all-templates)) ;(not (get symbol 'bnf-alternatives))
	(setq all-templates (cons (cons name nil) all-templates))) ;; lrs
    (put  symbol  'bnf-alternatives   alternatives)))
  
(defun parse-bnf-rules-in-buffer  nil
  (interactive)
  (bnf-mode)
  (beginning-of-buffer)
  (setq all-templates nil)
  (while (not (eobp))
    (scan-to-next-rule-separator)
    (scan-to-start-of-next-rule)
    (if (not (eobp))
	(parse-next-bnf-rule))))

(defun scan-to-start-of-next-rule  nil
  (interactive)
  (next-bnf-line)
  (while (and (not (eobp))
	      (looking-at bnf-rule-separator))
    (next-bnf-line)))

(defun load-bnf-file (filename)
  (interactive "fFile containing BNF: ")
  (message "loading BFN from file %s" filename)
  (save-excursion
    (set-buffer (get-buffer-create "*bnf-rules*"))
    (erase-buffer)
    (insert-file filename)
    (not-modified)
    (parse-bnf-rules-in-buffer)))

(defun expand-token nil
  "Expands token that point is inside or just after.  A window will be
popped up containing the alternative template expansions of the token.
Once a template is selected, it will replace the token in the current
buffer.  For convenience, the mark is pushed at the beginning of the
inserted template, and point is left at the end."
  (interactive)
  (condition-case foo
      (progn (forward-char 1) (re-search-backward bnf-token-start))
    (error (error "Cannot find start of token")))
  (let ((start-pos (dot))
	(column (current-column)))
    (push-mark)
    (condition-case foo
	(re-search-forward bnf-token-end)
      (error (error "Cannot find end of token")))
    (let* ((end-pos (dot))
	   (selected-token (buffer-substring start-pos end-pos)))
      (position-template (catch
			     'selected-template
			   (select-expansion-of selected-token))
			 column)
      (save-excursion
	(delete-region start-pos end-pos)))))


(defun insert-token (tname) ;; lrs
  "Inserts a valid Ada language template and expands it."
  (interactive
    (list
      ;; I would like to just call completing read, but this will give me back
      ;; the wrong value if the user gives a fill string but in the wrong case.
      ;; The klutzy call to all-completions is to get around this.
      (let ((completion-ignore-case t));; value will revert upon exit from let
  	(car (all-completions
	       (completing-read  "Ada Form: "
				 all-templates
				 'ada-tag-match-criterion
				 t)
	       all-templates)))))
  (insert "{" tname "} ")
  (expand-token)
  )

;; (defun select-expansion-of (token)
;;   "Places all possible expansions of the given TOKEN in the popped
;; buffer, *expansions*.  That buffer is placed in Buffer Menu Mode to
;; allow the user to select the template he/she wishes."
;;   (save-window-excursion
;;     (pop-to-buffer "*expansions*")
;;     (setq buffer-read-only nil)
;;     (erase-buffer)
;;     (insert "For " token ", choose one of the following:\n")
;;     (setq template-alternatives (get (intern-soft token)
;; 				     'bnf-alternatives))
;;     (insert (mapconcat
;; 	     (function (lambda (alt)
;; 			 (mapconcat (function (lambda (l)
;; 						l))
;; 				    alt
;; 				    "\\")))
;; 	     template-alternatives
;; 	     "\n"))
;;   (insert "\n")
;;   (setq buffer-read-only t)
;;   (beginning-of-buffer)
;;   (next-line 1)
;;   (beginning-of-line)
;;   (template-menu-mode)
;;   (recursive-edit)))

(defun select-expansion-of (token);; lrs enhanced
  "Either inserts the only possible expansion of token or
   Places all possible expansions of the given TOKEN in the popped
   buffer, *expansions*.  That buffer is placed in Buffer Menu Mode to
   allow the user to select the template he/she wishes."
  (setq template-alternatives (get (intern-soft token)
				   'bnf-alternatives))
  (if (null (cdr template-alternatives))
      (throw 'selected-template (car template-alternatives))
      (save-window-excursion
	(pop-to-buffer "*expansions*")
	(setq buffer-read-only nil)
	(erase-buffer)
	(insert "For " token ", choose one of the following:\n")
	(insert (mapconcat
		  (function (lambda (alt)
			      (mapconcat (function (lambda (l)
						     l))
					 alt
					 "\\")))
		  template-alternatives
		  "\n"))
	(insert "\n")
	(setq buffer-read-only t)
	(beginning-of-buffer)
	(next-line 1)
	(beginning-of-line)
	(template-menu-mode)
	(recursive-edit))))

(defun selected-template nil
  "Returns selected template."
  (interactive)
  (beginning-of-line)
  (let ((n (1- (count-lines 1 (dot)))))
    (if (< n 0)
	(error "No template on that line")
      (nth n template-alternatives))))

(defun throw-selected-template nil
  "Throws selected-template back to catch with 'selected-template tag."
  (interactive)
  (throw 'selected-template (selected-template)))

(defun template-menu-mode nil
  "Major mode for selecting from a menu of BNF templates.  You are
placed into a recursive edit to select one of the templates in the
buffer.
C-n, n, and space move you to the template on the next line.
C-p, p, and DEL   move you to the template on the previous line.
C-c selects the template the line is on, and exits the recursive edit."

  (interactive)
  (kill-all-local-variables)
  (use-local-map template-menu-mode-map)
  (setq truncate-lines t)
  (setq buffer-read-only t)
  (setq major-mode 'template-menu-mode)
  (setq mode-name "Template Menu")
  (if nil ;; lrs eliminated (boundp 'emacs-menu) ; kludge to determine if
					; we are running as emacstool
      (template-menu-activate))
  )
  
(defun position-template (template column)
  (let ((start (point))
	stop)    
    (insert
      (mapconcat
	(function (lambda (line)
		    (if (and (boundp 'indent-change) (numberp indent-change))
			(change-indentation-of line)
		      line)))
	template
	(concat "\n" (make-string column 32))))
    (setq stop (point))
    (goto-char start)
    (if (re-search-forward "{" stop t)
	(goto-char (match-beginning 0)))))
  


(defun change-indentation-of (line)
  "If variable indent-change is defined (by ada-mode, say),
then that indentation is used for each line of the template,
instead of the indentation the template was originally defined with."
  (let ((nspaces 0)
	(tline line))
    (while (string= (substring tline 0 1)  " ")
      (setq tline (substring tline 1))
      (setq nspaces (1+ nspaces)))
    (concat (make-string (/ (* indent-change nspaces) 2)
			 32)
	    tline)))

(setq template-menu-mode-map (make-keymap))
(suppress-keymap template-menu-mode-map)

(autoload 'template-menu-activate "~/el/template-menu"
	  "Activates the template menu" )

;;(define-key template-menu-mode-map "\^c"      'throw-selected-template)
(define-key template-menu-mode-map "b"      'throw-selected-template)
(define-key template-menu-mode-map "g"      'throw-selected-template)
(define-key template-menu-mode-map "s"      'throw-selected-template)
(define-key template-menu-mode-map "."      'throw-selected-template)

(define-key template-menu-mode-map "\^n"      'next-line)
(define-key template-menu-mode-map "n"      'next-line)
(define-key template-menu-mode-map "N"      'next-line)
(define-key template-menu-mode-map " "      'next-line)

(define-key template-menu-mode-map "\^p"      'previous-line)
(define-key template-menu-mode-map "p"      'previous-line)
(define-key template-menu-mode-map "P"      'previous-line)
(define-key template-menu-mode-map "\177"   'previous-line)
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦189164009⟧ TextFile

Derivation

TextFile
