nobody@KODAK.COM (Jeff Gerstenberger) (12/21/89)
I have a set of GNU Emacs macros which emulate the TDS folding editor.
The macros were originally supplied by Inmos (with absolutely no support
implied). Apparently the original was written by Tony Curtis of Exeter
University, and then subsequently modified by somebody named Erik. (I
don't know any more than this, I'm just attempting to give credit where
its due as best I can.) I have modified the macros quite a bit myself
in an attempt to get them to more closely emulate the actions of TDS.
The macros are written in LISP and should therefore be portable to any
machine which can run GNU Emacs. We're currently using it on Sun 3's,
Sun 4's and Sparcstations. The functions which are implemented in the
macros include: open/close fold, enter/exit fold, copy fold, move fold,
create/remove fold, and other "standard" editing operations (moving the
cursor around, deleting lines and words, etc.). Note that filed folds
are not supported. Also, in their current incarnation, the macros use
Emacs' point and mark extensively - something which in general should
be avoided and that experienced Emacs users may find to be a nuisance.
If there is interest in the macro package I can either mail it to those
who are interested, or post it in comp.sys.transputer.
DISCLAIMER: This software is NOT a supported product of Eastman Kodak.
Kodak assumes no responsibility for maintaining this software
and is not liable for any damage it may cause during its
use. We're happy to let you use it, but don't blame us
if it acts up!
Jeff Gerstenberger gerst@gerst.kodak.com
Digital Technology Center (716) 726-7003
Eastman Kodak Company
Rochester, NY 14653-5324nobody@KODAK.COM (Jeff Gerstenberger) (12/22/89)
This posting consists of two files. The first has Lisp code that should be
included in your .emacs file. It has a reference to an environment variable
ARCH_TYPE which we set in our .cshrc file according to the type of Sun workstation
we are currently logged into (sun3, sun4, or sun4c). The second file is the Lisp
source for the macros. It must be compiled using 'M-x byte-compile' in Emacs
before you can use it.
DISCLAIMER: This software is NOT a supported product of Eastman Kodak.
Kodak assumes no responsibility for maintaining this software
and is not liable for any damage it may cause during its
use. We're happy to let you use it, but don't blame us
if it acts up!
Jeff Gerstenberger gerst@gerst.kodak.com
Digital Technology Center (716) 726-7003
Eastman Kodak Company
Rochester, NY 14653-5324
------------------------------ Begin .emacs -----------------------------
(setq arch (getenv "ARCH_TYPE")) <<--- GET WORKSTATION TYPE
(setq load-path
(append '("/home/DTCS04/gerst/emacs") load-path)) <<--- CHANGE THIS
(autoload 'occam-mode "occam-mode" nil t nil)
(if (assoc "\\.occ" auto-mode-alist) nil
(nconc auto-mode-alist '(("\\.occ" . occam-mode))))
(if (assoc "\\.pgm" auto-mode-alist) nil
(nconc auto-mode-alist '(("\\.pgm" . occam-mode))))
------------------------------ End .emacs --------------------------------
------------------------------ Begin occam-mode.el -----------------------
;; This macro package is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. Everyone is granted permission to copy,
;; modify and redistribute these macros, but they may not be sold. This
;; notice must be included on all copies of the macro package.
;;global variables
(defvar flag 0 " create fold flag")
(defvar mflag 0 " move fold flag")
(defvar bufobj 0 " unique buffer number")
(defvar foldlist nil "contains each folder")
(defvar contextlist nil "Used when folders are created")
(defvar indentation 0 "indentation level of folder")
(defvar c-string "" "used in copy-fold")
(defvar c-name "" "used in copy-fold")
(defvar occam-mode-map nil "Keymap used in Occam-mode")
(defvar occam-mode-abbrev-table nil "Abbrev table in use in Occam-mode tables")
;;functions
(defun m-isfoldline ()
"Returns true if current line is a fold line"
(beginning-of-line nil)
(forward-to-indentation 0)
(cond ((= (following-char) 46)
(forward-char 1)
(cond ((= (following-char) 46)
(forward-char 1)
(cond ((= (following-char) 46) t)
(t nil)))
(t nil)))
(t nil)))
(defun m-get-bufname ()
"Reads the buffer name from a foldline or start-of-folder line"
(setq name "")
(beginning-of-line 1)
(forward-to-indentation 0)
(while (or (= (following-char) 46)
(= (following-char) 45) (= (following-char) 123))
(forward-char 1))
(while (not (= (following-char) 58))
(setq name (concat name (make-string 1 (following-char))))
(forward-char 1))
name)
(defun m-get-comment ()
"Reads the comment field from a foldline or start-of-folder line"
(setq name "")
(beginning-of-line 1)
(forward-to-indentation 0)
(while (or (= (following-char) 46)
(= (following-char) 45) (= (following-char) 123))
(forward-char 1))
(while (not (= (following-char) 58))
(forward-char 1))
(forward-char 1) ;;read colon
(while (not (eolp))
(setq name (concat name (make-string 1 (following-char))))
(forward-char 1))
name)
(defun m-remove-foldmarks (bufname)
(setq mv-savebuf (current-buffer))
(switch-to-buffer bufname)
(beginning-of-buffer)
(kill-line 1)
(end-of-buffer)
(beginning-of-line)
(kill-line nil)
(switch-to-buffer mv-savebuf))
(defun m-remove-context (element newfold oldfold)
(cond ((equal (car (cdr element)) newfold) (list (car element)
oldfold nil))
( t element)))
(defun m-remove-fold ()
(interactive)
(cond ((m-isfoldline)
(setq indentation (current-indentation))
(setq bufname (m-get-bufname))
(setq foldcontext (car (cdr (assoc bufname foldlist))))
(beginning-of-line)
(kill-line 1)
(m-remove-foldmarks bufname)
(insert-buffer bufname)
(kill-buffer bufname)
(setq foldlist (mapcar '(lambda (x)
(m-remove-context x bufname
foldcontext)) foldlist))
(set-variable 'foldlist (m-remove foldlist (assoc bufname foldlist)))
(indent-rigidly (dot) (mark) indentation)
(m-back-to-first-nonbl))))
(defun m-empty-line ()
(beginning-of-line)
(while (= (following-char) 32) (forward-char 1))
(= (following-char) 10))
(defun m-check-indentation (pos)
(setq noflines (- (count-lines (mark) (dot)) 2))
(save-excursion
(setq indent-ok t)
(setq contextlist nil)
(while (and (> noflines 0) indent-ok)
(forward-line -1)
(cond ((or (m-isfoldline) (m-is-l-line))
(setq contextlist (cons (m-get-bufname) contextlist))))
(setq noflines (- noflines 1))
(setq indent-ok (or (<= pos (current-indentation)) (m-empty-line)))))
indent-ok)
(defun m-check-fold-nesting ()
(setq noflines (- (count-lines (mark) (dot)) 2))
(save-excursion
(setq nest-count 0)
(while (> noflines 0)
(forward-line -1)
(cond ((m-is-r-line)
(setq nest-count (+ nest-count 1)))
((m-is-l-line)
(setq nest-count (- nest-count 1))))
(setq noflines (- noflines 1))))
(zerop nest-count))
(defun m-remove (list el)
(cond ((equal nil list) nil)
((equal (car list) el) (cdr list))
(t (append (list (car list))(m-remove (cdr list) el)))))
(defun m-current-folder ()
"Get the buffer name of the current folder"
(save-excursion
(cond ((m-is-r-line) (forward-line -1)))
(setq level 1)
(while (> level 0)
(cond ((m-is-r-line) (setq level (+ level 1)))
((m-is-l-line) (setq level (- level 1))))
(cond ((not(= level 0)) (forward-line -1))))
(setq name "")
(beginning-of-line 1)
(forward-to-indentation 0)
(while (or (= (following-char) 45) (= (following-char) 123))
(forward-char 1))
(while (not (= (following-char) 58))
(setq name (concat name (make-string 1 (following-char))))
(forward-char 1)))
name)
(defun member (a list)
"True if arg is a member of list(arg2), otherwise nil"
(cond ((eq list nil) nil)
((equal a (car list)) t)
(t (member a (cdr list)))))
(defun m-change-context (element i-list newcontext oldcont)
(cond ((and (member (car element) i-list)(equal (car (cdr element)) oldcont))
(list (car element) newcontext nil))
(t element)))
(defun m-create-fold ()
(interactive )
(cond ((= flag 0) (cond ((<= (current-column) (current-indentation))
(set-mark (dot))
(setq indentation (current-column))
(insert-string "--{")
(setq indent2 indentation)
(while (= (following-char) 32)
(setq indent2 (+ indent2 1))
(delete-char 1))
(open-line 1)
(forward-line 1)
(indent-to indent2 0)
(set-variable 'flag 1)
(message "Creating fold..."))
(t (error "Inappropriate fold position"))))
((= flag 1) (cond ((and (> (dot)(mark))
(> (count-lines (mark) (dot)) 0))
(cond ((not (m-check-fold-nesting))
(error "Illegal fold nesting"))
((not (m-check-indentation indentation))
(error "Lines have wrong indentation"))
(t
(beginning-of-line)
(open-line 1)
(indent-to indentation 0)
(insert-string "--}")
(kill-region (mark) (dot))
(setq bufobj (generate-new-buffer ""))
(setq c-fold (m-current-folder))
(cond ((not (eq contextlist nil))
(setq foldlist
(mapcar '(lambda (x)
(m-change-context x
contextlist
(buffer-name bufobj)
c-fold))
foldlist))))
(set-variable 'foldlist
(append foldlist (list (list
(buffer-name bufobj)
c-fold))))
(switch-to-buffer bufobj)
(setq major-mode 'occam-mode)
(setq mode-name "Occam")
(use-local-map occam-mode-map)
(setq indent-tabs-mode nil)
(abbrev-mode 0)
(setq local-abbrev-table
occam-mode-abbrev-table)
(yank)
(indent-rigidly (mark) (dot) (- indentation))
(switch-to-buffer nil)
(kill-line 1)
(insert-string "...")
(insert-string (buffer-name bufobj))
(insert-string ":")
(open-line 1)
(set-variable 'flag 0))))
(t (error "Cursor must be below first line"))))))
(defun m-enter-fold ()
(interactive)
(cond ((m-isfoldline)
(setq bufname (m-get-bufname))
(setq comment (m-get-comment))
(switch-to-buffer bufname)
(beginning-of-buffer)
(forward-char 3)
(while (not (eolp))(delete-char 1))
(insert-string bufname)
(insert-string ":")
(insert-string comment)
(forward-line 1)
(while (not (m-last-line))
(cond ((m-is-l-line)
(beginning-of-line)
(set-mark-command nil)
(m-find-outer-rline)
(set-mark-command 1)
(exchange-dot-and-mark)
(m-close)))
(forward-line 1))
(beginning-of-buffer))))
(defun m-change-bufname (bname)
(forward-to-indentation 0)
(forward-char 3)
(while (not (= (following-char) 58)) (delete-char 1))
(insert-string bname))
(defun m-exit-fold ()
(interactive)
(setq element (car(cdr (assoc (buffer-name (current-buffer))
foldlist))))
(cond ((equal element (concat (buffer-name(current-buffer)) ".TOP"))
(m-close-down))
((not(equal element nil))
(beginning-of-buffer)
(forward-char 3)
(while (not (eolp))(delete-char 1))
(switch-to-buffer element))
(t (error "Illegal to exit from this level, use 'Finish'"))))
(defun m-open-fold ()
(interactive)
(cond ((m-isfoldline)
(cond ((not (string-match ".TOP" (buffer-name (current-buffer))))
(setq indentation (current-indentation))
(setq bufname (m-get-bufname))
(setq comment (m-get-comment))
(beginning-of-line)
(kill-line 1)
(open-line 1)
(switch-to-buffer bufname)
(beginning-of-buffer)
(forward-char 3)
(while (not (eolp)) (delete-char 1))
(insert-string bufname)
(insert-string ":")
(insert-string comment)
(switch-to-buffer nil)
(insert-buffer bufname)
(indent-rigidly (dot) (mark) indentation))
(t (error "Use 'Enter fold'"))))))
(defun m-find-outer-rline ()
(setq count 1)
(cond ((m-is-l-line) (forward-line)))
(while (> count 0)
(cond ((m-is-r-line)
(setq count (- count 1))
(cond ((= count 0) (end-of-line)
(set-mark-command nil))))
((m-is-l-line) (setq count (+ count 1))))
(forward-line 1)))
(defun m-is-r-line ()
"Returns true if current line is a end-of-fold line (right bracket)"
(beginning-of-line nil)
(forward-to-indentation 0)
(cond ((= (following-char) 45)
(forward-char 1)
(cond ((= (following-char) 45)
(forward-char 1)
(cond ((= (following-char) 125) t)
(t nil)))
(t nil)))
(t nil)))
(defun m-is-l-line ()
"Returns true if current line is a start-of-fold line (left bracket)"
(beginning-of-line nil)
(forward-to-indentation 0)
(cond ((= (following-char) 45)
(forward-char 1)
(cond ((= (following-char) 45)
(forward-char 1)
(cond ((= (following-char) 123) t)
(t nil)))
(t nil)))
(t nil)))
(defun m-close ()
(setq name "")
(setq comment "")
(beginning-of-line 1)
(forward-to-indentation 0)
(while (or (= (following-char) 45) (= (following-char) 123))
(forward-char 1))
(while (not (= (following-char) 58))
(setq name (concat name (make-string 1 (following-char))))
(forward-char 1))
(cond ((not(equal name (buffer-name (current-buffer))))
(while (not (eolp))
(setq comment (concat comment (make-string 1 (following-char))))
(forward-char 1))
(beginning-of-line)
(setq indentation (current-indentation))
(copy-to-buffer name (mark) (dot))
(kill-region (mark) (dot))
(switch-to-buffer name)
(setq indent-tabs-mode nil)
(mark-whole-buffer)
(indent-rigidly (dot) (mark) (- indentation))
(switch-to-buffer nil)
(indent-to indentation 0)
(insert-string "...")
(insert-string name )
(insert-string comment))
(t (error "Use 'Exit fold'"))))
(defun m-close-fold ()
(interactive)
(m-find-outer-rline)
(forward-line -1)
(setq count 1)
(while (> count 0)
(forward-line -1)
(cond ((m-is-r-line)
(end-of-line)
(set-mark-command nil)
(setq count (+ count 1)))
((m-is-l-line)
(m-close)
(cond ((> count 1)(pop-mark)))
(setq count (- count 1))))))
(defun m-insert-folds-in-foldlist (buf)
(beginning-of-buffer)
(forward-line 1)
(while (not (equal buf (buffer-name (current-buffer))))
(cond ((m-is-l-line)
(set-mark-command nil)
(m-find-outer-rline)
(set-mark-command 1)
(exchange-dot-and-mark)
(setq next-buf (buffer-name
(generate-new-buffer "")))
(setq foldlist (append foldlist (list
(list next-buf
(buffer-name (current-buffer
))))))
(m-insert-new-bufname next-buf)
(m-close)
(switch-to-buffer next-buf)
(setq major-mode 'occam-mode)
(setq mode-name "Occam")
(use-local-map occam-mode-map)
(setq indent-tabs-mode nil)
(abbrev-mode 0)
(setq local-abbrev-table occam-mode-abbrev-table))
((m-isfoldline)
(m-open-fold)
(forward-line -1))
((m-is-r-line)
(switch-to-buffer (car (cdr (assoc (buffer-name (current-buffer))
foldlist))))))
(forward-line 1)))
(defun m-prepare-to-save ()
(beginning-of-buffer)
(while (not(m-last-line))
(forward-line 1)
(cond ((m-isfoldline)
(m-open-fold)))))
(defun m-insert-list (name level set-up-list)
(cond ((>= level (car(cdr(car set-up-list))))
(cons (list name level) set-up-list))
(t (cons (car set-up-list)(m-insert-list name level (cdr set-up-list)
)))))
(defun m-insert-new-bufname (b-obj)
(forward-to-indentation 0)
(forward-char 3)
(while (not (= (following-char) 58)) (delete-char 1))
(insert-string b-obj))
(defun m-init-new-fold ()
(insert-string "--{")
(insert-string (buffer-name (current-buffer)))
(insert-string ":")
(insert-string (buffer-name (current-buffer)))
(split-line )
(forward-line 1)
(insert-string "--}"))
(defun m-last-line ()
(save-excursion
(end-of-line)
(cond ((eobp) t)
(t nil))))
(defun m-close-down ()
(beginning-of-buffer)
(while (not(m-last-line))
(forward-line 1)
(cond ((m-isfoldline)
(m-open-fold))))
(save-buffer)
(switch-to-buffer (concat (buffer-name (current-buffer)) ".TOP")))
(defun finish ()
(interactive)
(cond ((string-match ".TOP" (buffer-name (current-buffer)) nil)
(kill-emacs 1))
(t (error "Illegal to finish from this level, use 'Exit fold'"))))
(defun m-up-to-top-level ()
(interactive)
(while (not (string-match ".TOP" (buffer-name (current-buffer))))
(m-exit-fold)))
(defun m-tab ()
(interactive)
(insert-string " "))
(defun m-linefeed ()
(interactive)
(setq ind (current-indentation))
(newline)
(indent-to ind))
(defun m-back-to-first-nonbl ()
(interactive)
(beginning-of-line)
(forward-to-indentation 0))
(defun m-delete-line ()
"Delete entire line (and newline character)"
(interactive)
(beginning-of-line)
(kill-line 1))
(defun m-delete-word-left ()
"Delete word to left of cursor. If no text on the current line,
delete blanks between fold indentation and current cursor position."
(interactive)
(setq save-point (point))
(save-excursion
(forward-word -1)
(setq noflines (count-lines (point) save-point)))
(cond ((= noflines 1)
(backward-kill-word 1))
(t
(save-excursion
(m-find-outer-rline)
(setq save-indent (current-indentation)))
(while (> (current-column) save-indent)
(delete-char -1)))))
(defun m-delete-word-right ()
"Delete word to right of cursor without crossing a NEWLINE character."
(interactive)
(setq save-point (point))
(save-excursion
(forward-word 1)
(setq noflines (count-lines (point) save-point)))
(cond ((= noflines 1)
(kill-word 1)
(delete-char 1))))
(defun m-copy ()
"Copy folder or line"
(interactive)
(cond ((m-isfoldline)
(setq c-file nil)
(setq com (m-get-comment))
(setq orig (current-buffer))
(switch-to-buffer (m-get-bufname))
(setq newb (generate-new-buffer ""))
(setq tmp (buffer-name newb))
(mark-whole-buffer)
(copy-to-buffer newb (dot) (mark))
(switch-to-buffer newb)
(setq c-name (buffer-name newb))
(setq c-string (concat "..." (buffer-name newb) ":" com))
(setq major-mode 'occam-mode)
(setq mode-name "Occam")
(use-local-map occam-mode-map)
(setq indent-tabs-mode nil)
(abbrev-mode 0)
(setq local-abbrev-table occam-mode-abbrev-table)
(switch-to-buffer orig)
(setq foldlist (append foldlist (list (list
c-name
(m-current-folder)))))
(setq ind (current-indentation))
(forward-to-indentation 0)
(insert-string c-string)
(open-line 1)
(forward-line 1)
(indent-to ind 0)
(forward-line -1)
(setq orig (current-buffer))
(switch-to-buffer (m-get-bufname))
(switch-to-buffer c-name)
(m-insert-folds-in-foldlist (buffer-name orig)))
(t (beginning-of-line)
(setq newb (generate-new-buffer "cbuf"))
(let ((beg (point)))
(forward-line 1)
(copy-to-buffer newb beg (point)))
(insert-buffer newb)
(kill-buffer newb))))
(defun m-move ()
"Move folder or line"
(interactive )
(cond ((= mflag 0) (cond ((not (or (m-is-r-line) (m-is-l-line)))
(beginning-of-line)
(setq mname (generate-new-buffer "mbuf"))
(let ((beg (point)))
(forward-line 1)
(copy-to-buffer mname beg (point))
(delete-region beg (point)))
(set-variable 'mflag 1)
(message "Moving..."))
(t (error "Inappropriate fold position"))))
((= mflag 1) (beginning-of-line)
(insert-buffer mname)
(kill-buffer mname)
(set-variable 'mflag 0)
(cond ((and (m-isfoldline)
(not (equal (m-current-folder) (car (cdr
(assoc (m-get-bufname) foldlist))))))
(setq oldfold (assoc (m-get-bufname) foldlist))
(set-variable 'foldlist (m-remove foldlist oldfold))
(set-variable 'foldlist (append foldlist
(list (list (m-get-bufname)
(m-current-folder)))))
)))))
(defun m-read-number (sel)
(cond ((= sel 1) (forward-line 1)))
(beginning-of-line)
(forward-to-indentation 0)
(setq num "")
(while (not (= (following-char) 32))
(setq num (concat num (make-string 1 (following-char))))
(forward-char 1))
(string-to-int num))
(defun m-top-of-fold ()
"Move point to top of current fold"
(interactive)
(cond ((m-is-r-line) (forward-line -1)))
(setq level 1)
(while (> level 0)
(cond ((m-is-r-line) (setq level (+ level 1)))
((m-is-l-line) (setq level (- level 1))))
(cond ((not(= level 0)) (forward-line -1))))
(beginning-of-line 1)
(forward-to-indentation 0))
(defun m-bottom-of-fold ()
"Move point to bottom of current fold"
(interactive)
(cond ((m-is-l-line) (forward-line 1)))
(setq level 1)
(while (> level 0)
(cond ((m-is-r-line) (setq level (- level 1)))
((m-is-l-line) (setq level (+ level 1))))
(cond ((not(= level 0)) (forward-line 1))))
(beginning-of-line 1)
(forward-to-indentation 0))
(defun m-get-offset ()
(-(- (m-read-number 0) (m-read-number 1))))
(defun m-display-line (linenr)
(interactive)
(m-up-to-top-level)
(beginning-of-buffer)
(m-enter-fold)
(setq lnr 1)
(while (not (= lnr linenr))
(cond ((m-isfoldline) (m-open-fold))
((m-is-r-line) (m-close-fold)))
(forward-line 1)
(setq lnr (+ lnr 1))))
(defun m-find-faulty-line ()
(interactive)
(setq linenr (string-to-int
(read-string "What line-number? ")))
(m-display-line linenr))
(defun m-nosave ()
(interactive)
(error "Use 'Exit fold' to save file"))
(defun m-noquit ()
(interactive)
(error "Use 'Finish' to quit from GNU Emacs"))
(defun m-describe-occam-keys ()
(interactive)
(describe-function 'm-occam-keys))
(defun m-occam-keys ()
" GNU Emacs Occam Folding Editor
ALT+ DelWordLeft Restore DelWordRight
R1,R2,R3 DelToEol DelLine DelCharRight
ALT+ Enter CopyLine Exit
R4,R5,R6 Open MoveLine Close
ALT+ CreateFold PageUp RemoveFold
R7,R8,R9 StartOfLine CursorUp EndOfLine
ALT+ WordLeft Finish WordRight
R10,R11,R12 CursorLeft AbbrevMode CursorRight
ALT+ TopOfFold PageDown BottomOfFold
R13,R14,R15 LineUp Down LineDown
F6 DisplayLine
ALT+h KeyBindings
Eastman Kodak Digital Technology Center (updated 12/15/89)")
(defun m-initial-close-fold(parent-buf-name)
(interactive)
(beginning-of-line)
(let ((my-start (point))
(my-indent (current-indentation))
(my-buf-name (buffer-name (generate-new-buffer "")))
(my-comment (m-get-comment)))
(m-change-bufname my-buf-name)
(setq foldlist (append foldlist (list (list my-buf-name parent-buf-name))))
(forward-line 1)
(while (not (or (m-is-r-line) (eobp)))
(cond ((m-is-l-line)
(save-excursion (m-initial-close-fold my-buf-name))
(forward-line 1))
(t (forward-line 1))))
(end-of-line)
(copy-to-buffer my-buf-name my-start (point))
(kill-region my-start (point))
(indent-to my-indent)
(insert-string (concat "..." my-buf-name ":" my-comment))
(set-buffer my-buf-name)
(setq major-mode 'occam-mode)
(setq mode-name "Occam")
(use-local-map occam-mode-map)
(setq indent-tabs-mode nil)
(abbrev-mode 0)
(setq local-abbrev-table occam-mode-abbrev-table)
(mark-whole-buffer)
(indent-rigidly (dot) (mark) (- my-indent)))
(set-buffer parent-buf-name))
(defun occam-mode ()
(interactive)
(m-inits-for-occam-mode)
(generate-new-buffer "")
(setq foldlist (list(list (buffer-name(current-buffer))
(concat (buffer-name(current-buffer)) ".TOP"))))
(cond ((= (buffer-size) 0)
(m-init-new-fold)))
(beginning-of-buffer)
(setq file-buf (buffer-name (current-buffer)))
(m-insert-new-bufname file-buf)
(forward-char 1)
(while (not (eolp)) (delete-char 1))
(insert-string file-buf)
(generate-new-buffer (concat file-buf ".TOP"))
(switch-to-buffer (concat file-buf ".TOP" ))
(beginning-of-buffer)
(insert-string (concat "..." file-buf ":" file-buf))
(setq major-mode 'occam-mode)
(setq mode-name "Occam")
(use-local-map occam-mode-map)
(setq indent-tabs-mode nil)
(abbrev-mode 0)
(setq local-abbrev-table occam-mode-abbrev-table)
(switch-to-buffer file-buf)
(beginning-of-buffer)
(forward-line 1)
(while (not (m-is-r-line))
(cond ((m-is-l-line)
(m-initial-close-fold (buffer-name (current-buffer))))
((m-is-r-line)
(message "Found r-line")))
(forward-line 1)))
(defun m-inits-for-occam-mode ()
(if (not occam-mode-map)
(progn
(setq occam-mode-map (make-sparse-keymap))
(define-key occam-mode-map "[208z" 'kill-line) ;;R1
(define-key occam-mode-map "[209z" 'm-delete-line) ;;R2
(define-key occam-mode-map "[210z" 'delete-char) ;;R3
(define-key occam-mode-map "[211z" 'm-open-fold) ;;R4
(define-key occam-mode-map "[212z" 'm-move) ;;R5
(define-key occam-mode-map "[213z" 'm-close-fold) ;;R6
(define-key occam-mode-map "[214z" 'm-back-to-first-nonbl) ;;R7
(define-key occam-mode-map "[A" 'previous-line) ;;R8
(define-key occam-mode-map "[216z" 'end-of-line) ;;R9
(define-key occam-mode-map "[D" 'backward-char) ;;R10
(define-key occam-mode-map "[218z" 'abbrev-mode) ;;R11
(define-key occam-mode-map "[C" 'forward-char) ;;R12
(define-key occam-mode-map "[220z" 'scroll-down-in-place) ;;R13
(define-key occam-mode-map "[B" 'next-line) ;;R14
(define-key occam-mode-map "[222z" 'scroll-up-in-place) ;;R15
(cond ((equal arch "sun4c")
(define-key occam-mode-map "[247z[208z" 'm-delete-word-left) ;;ALT R1
(define-key occam-mode-map "[247z[209z" 'yank) ;;ALT R2
(define-key occam-mode-map "[247z[210z" 'm-delete-word-right) ;;ALT R3
(define-key occam-mode-map "[247z[211z" 'm-enter-fold) ;;ALT R4
(define-key occam-mode-map "[247z[212z" 'm-copy) ;;ALT R5
(define-key occam-mode-map "[247z[213z" 'm-exit-fold) ;;ALT R6
(define-key occam-mode-map "[247z[214z" 'm-create-fold) ;;ALT R7
(define-key occam-mode-map "[247z[A" 'scroll-down) ;;ALT R8
(define-key occam-mode-map "[247z[216z" 'm-remove-fold) ;;ALT R9
(define-key occam-mode-map "[247z[D" 'backward-word) ;;ALT R10
(define-key occam-mode-map "[247z[218z" 'finish) ;;ALT R11
(define-key occam-mode-map "[247z[C" 'forward-word) ;;ALT R12
(define-key occam-mode-map "[247z[220z" 'm-top-of-fold) ;;ALT R13
(define-key occam-mode-map "[247z[B" 'scroll-up) ;;ALT R14
(define-key occam-mode-map "[247z[222z" 'm-bottom-of-fold) ;;ALT R15
(define-key occam-mode-map "[247zh" 'm-describe-occam-keys)) ;;ALT h
(t
(define-key occam-mode-map "[208z" 'm-delete-word-left) ;;ALT R1
(define-key occam-mode-map "[209z" 'yank) ;;ALT R2
(define-key occam-mode-map "[210z" 'm-delete-word-right) ;;ALT R3
(define-key occam-mode-map "[211z" 'm-enter-fold) ;;ALT R4
(define-key occam-mode-map "[212z" 'm-copy) ;;ALT R5
(define-key occam-mode-map "[213z" 'm-exit-fold) ;;ALT R6
(define-key occam-mode-map "[214z" 'm-create-fold) ;;ALT R7
(define-key occam-mode-map "[A" 'scroll-down) ;;ALT R8
(define-key occam-mode-map "[216z" 'm-remove-fold) ;;ALT R9
(define-key occam-mode-map "[D" 'backward-word) ;;ALT R10
(define-key occam-mode-map "[218z" 'finish) ;;ALT R11
(define-key occam-mode-map "[C" 'forward-word) ;;ALT R12
(define-key occam-mode-map "[220z" 'm-top-of-fold) ;;ALT R13
(define-key occam-mode-map "[B" 'scroll-up) ;;ALT R14
(define-key occam-mode-map "[222z" 'm-bottom-of-fold) ;;ALT R15
(define-key occam-mode-map "h" 'm-describe-occam-keys))) ;;ALT h
(define-key occam-mode-map "[229z" 'm-find-faulty-line) ;;F6
(define-key occam-mode-map "[230z" 'occam-compile) ;;F7
(define-key occam-mode-map "[231z" 'occam-next-error) ;;F8
(define-key occam-mode-map "\Oq" 'm-up-to-top-level) ;;keypad-1
(define-key occam-mode-map "
(define-key occam-mode-map "\n" 'm-linefeed ))) ;; LF-key
(define-key occam-mode-map "\t" 'm-tab ) ;; tab-key
(define-key occam-mode-map "" 'm-nosave ) ;;
(define-key occam-mode-map "" 'm-noquit ) ;;
(use-local-map occam-mode-map)
(setq major-mode 'occam-mode)
(setq mode-name "Occam")
(setq indent-tabs-mode nil)
(define-abbrev-table 'occam-mode-abbrev-table ())
(define-abbrev occam-mode-abbrev-table "alt" "ALT")
(define-abbrev occam-mode-abbrev-table "byte" "BYTE")
(define-abbrev occam-mode-abbrev-table "chan" "CHAN")
(define-abbrev occam-mode-abbrev-table "int" "INT")
(define-abbrev occam-mode-abbrev-table "par" "PAR")
(define-abbrev occam-mode-abbrev-table "pri" "PRI")
(define-abbrev occam-mode-abbrev-table "proc" "PROC")
(define-abbrev occam-mode-abbrev-table "real" "REAL")
(define-abbrev occam-mode-abbrev-table "seq" "SEQ")
(define-abbrev occam-mode-abbrev-table "skip" "SKIP")
(define-abbrev occam-mode-abbrev-table "val" "VAL")
(abbrev-mode 0)
(setq local-abbrev-table occam-mode-abbrev-table))
------------------------------ End occam-mode.el -----------------------