(defvar clu-mode-syntax-table nil "\ Syntax table used while in clu mode.") (if (null clu-mode-syntax-table) (let ((st (syntax-table))) (unwind-protect (progn (setq clu-mode-syntax-table (make-syntax-table)) (set-syntax-table clu-mode-syntax-table) (modify-syntax-entry 91 "(] ") (modify-syntax-entry 93 ")[ ") (modify-syntax-entry 123 "(} ") (modify-syntax-entry 125 "){ ") (modify-syntax-entry 34 "\" ") (modify-syntax-entry 39 "\" ") (modify-syntax-entry 95 "w ") (modify-syntax-entry 37 "< ") (modify-syntax-entry 10 "> ")) (set-syntax-table st)))) (defvar clu-mode-map nil "\ keymap used in clu-mode") (if (not clu-mode-map) (progn (setq clu-mode-map (make-sparse-keymap)) (define-key clu-mode-map " " (quote clu-tab)) (define-key clu-mode-map " " (quote clu-ret)) (define-key clu-mode-map "&" (quote clu-compile)) (define-key clu-mode-map " " (quote cludent)) (define-key clu-mode-map " " (quote kill-compilation)))) (defun clu-mode nil "\ Clu-mode is for editing CLU programs. TAB at beginning of line reindents the line, but sometimes poorly; with prefix-arg, indents all following lines, but slowly RET new-line-and-indent ESC-TAB indents the entire buffer (works better than TAB) ESC-& runs interactive CLU compiler ^X` finds the next error message ^X^K kills the compiler Variables controlling indentation style: clu-indent If nil, turns off automatic language directed indent. Default is t. clu-indent-size Each indentation level offsets text by this much. Default is 4. clu-cluster-indent If nil, turns off indent for cluster and guardian bodies. Default is t. clu-except-offset Extra indentation for line beginning with except-statement. Default is 1. clu-when-offset Extra indentation for line beginning with when-statement. Default is -1." (interactive) (byte-code "Ĉ !щ҉ !\"!։!׉!؉ !ĉ !ى ! !P !ii!" [clu-mode-map mode-name major-mode clu-mode-syntax-table nil local-abbrev-table clu-mode-abbrev-table indent-line-function comment-start comment-column last-filename name-of-mode compile-command buffer-file-name clu-mode-hook kill-all-local-variables use-local-map "Clu" clu-mode set-syntax-table define-abbrev-table make-local-variable clu-indent-line "%" 40 "clu-compilation" "pclu " file-name-nondirectory boundp funcall] 14)) (defvar clu-mode-abbrev-table nil "\ Abbrev table in use in Clu-mode buffers.") (defvar clu-indent t "\ *If non-nil TAB and RET will do fancy things") (defvar clu-indent-size 4 "\ *Each indentation level offsets text by this much") (defvar clu-cluster-indent t "\ *If nil cluster and guardian bodies will not be indented") (defvar clu-except-offset 1 "\ *Extra indentation for except-statement") (defvar clu-when-offset -1 "\ *Extra indentation for when-statement") (defun clu-module (string) "\ Expands current word to a template for a module" (byte-code " `!`\" Q! P!)!" [id string nil beginning-of-line buffer-substring skip-chars-forward "^ $" end-of-line insert-string " = " " () " clu-indent-line "end " skip-chars-backward "^("] 9)) (defun clu-tab (&optional argp) "\ Indent current line if point is at beginning of line, else insert tab." (interactive "P") (byte-code "ˆn? ?c> ? >!`!`dW6 !& b!" [clu-indent argp nil 9 beginning-of-line clu-indent-line message "Reindent started..." set-mark forward-line 1 mark "Reindent done..."] 9)) (defun clu-ret nil "\ Newline and indent" (interactive) (byte-code "?  " [clu-indent nil newline clu-indent-line] 4)) (defun clu-indent-line (&optional whole-exp) "\ Indent current line as Clu code. Argument means shift any additional lines of grouping rigidly with this line." (interactive "P") (byte-code " j" [nil delete-horizontal-space calculate-clu-indent] 3)) (defun calculate-clu-indent (&optional parse-start) "\ Return appropriate indentation for current line as Clu code." (byte-code " `e=Ă2! ` gU?gU? !gULTgUYS!!!v!v v!}ThUhU!!!!!!T!S!) !! Z! Z! Z ! !! \\2!& \\2!2 \\ \"\\)," [count count1 col end-of-line-pos nil clu-cluster-indent clu-except-offset clu-when-offset clu-indent-size 0 beginning-of-line backward-word 1 end-of-line current-indentation 10 37 backward-char 40 41 looking-at "=[ ]*" skip-chars-forward "= " "iter" "proc" "cluster" 32 9 "for[ (]+" "if[ (]+" "while" "begin" "except" "tagcase" "end[ ]+" forward-char " " "else" -2 "when" forward-word forward-to-indentation *] 37)) (defun clu-compile nil "\ Compile the Clu-program in the current buffer" (interactive) (byte-code "È!!=2!p! ! !`Z\" !*H!H!q )\"" [compilation-process buf cbuf nil boundp process-status run process-buffer call-interactively clu-command pop-to-buffer set-window-start get-buffer-window 12 compile clu-compilation-mode set-process-filter clu-filter] 14)) (defvar clu-regexp "\\(^Compiling[ a-zA-Z0-9/.]+\\)\\|\\(^[0-9]+:\\)\\|\\(^command(s):\\)" "\ Regular expression for filename-lines and error-msg-lines") (defun clu-filter (proc string) "\ This gets called with each string the compiler outputs" (byte-code "ɋ" [proc save-pos save-pos2 save-pos3 string clu-regexp nil t last-filename ((byte-code "!qdb` ! b #x!!!b!I!! bP!s![db !s!s b!`!`\") b#!|+db" [proc save-pos save-pos2 save-pos3 string clu-regexp nil t last-filename process-buffer insert-string re-search-forward match-beginning 0 match-end looking-at "[0-9]+:" skip-chars-forward "^ " " " ", line " "command(s):" ding message "Clu compiler ready to receive new command(s)..." "Compiling" skip-chars-backward "^ " buffer-substring "^ $" " " delete-backward-char 1] 21))] 1)) (defun clu-command (command) "\ This gets called to prompt and get command for running compiler" (interactive (byte-code "\"C" [read-input "Clu command(s): " ""] 3)) (byte-code "ˆ P\"" [compilation-process command nil send-string " "] 4)) (defvar clu-compilation-mode nil) (defvar clu-compilation-mode-map nil) (if (not clu-compilation-mode-map) (progn (setq clu-compilation-mode-map (make-sparse-keymap)) (define-key clu-compilation-mode-map "&" (quote clu-compilation-go-end)) (define-key clu-compilation-mode-map " " (quote clu-compilation-command)))) (defun clu-compilation-mode nil "\ string+RET at end of file after the text \"command(s):\" is interpreted as a command to the clu-compiler" (interactive) (byte-code "È!ʼnƉ" [clu-compilation-mode-map mode-name major-mode nil use-local-map "clu-compilation" clu-compilation-mode] 3)) (defun clu-compilation-command nil "\ This gets called when RET-key is input to *compilation* buffer" (interactive) (byte-code "ˆ!`d\"?!6!`!`!`\" b`d\" P\"" [command compilation-process nil skip-chars-forward " " equal insert-string " " skip-chars-backward "^:" set-mark buffer-substring "^$" mark delete-region send-string] 13)) (defun clu-compilation-go-end nil "\ This gets called on ESC-&" (interactive) (byte-code "db" [nil] 1)) (defun cludent nil "\ indent CLU buffer" (interactive) (byte-code "ed$eb" [t nil shell-command-on-region "cludent"] 5)) (defvar clu-doc-version "1.1" "\ The current version of clu-doc") (defvar clu-doc-start "" "\ The special string that starts each doc record in the CLU-DOC file") (defvar clu-doc-key-length 2 "\ Length of the description code following the clu-doc-start string in the CLU-DOC file") (defvar clu-doc-edit nil "\ *If non nil, instead of just printing out a copy of the documentation in the other window, we actually visit the CLU-DOC file. This is useful for editing that file.") (defvar clu-doc-buffer nil "\ buffer where the CLU documentation lives") (defvar clu-doc-file-name nil "\ *File name of the current CLU-DOC file, if null user is prompted for it.") (defvar clu-doc-file-suffix ".clu" "\ *Suffix of Clu files") (defvar clu-doc-dumped-files-to-load nil "\ *List of clu doc files (each created by clu-doc-dump-file) that is loaded at initialization time into the current session of the CLU help facility") (defvar clu-doc-symbol-key "d" "\ *Help key for CLU symbols") (defvar clu-doc-general-key "g" "\ *Help key for CLU general topics") (defvar clu-doc-apropos-key "/" "\ *Help key for CLU apropos") (define-key help-map clu-doc-symbol-key (quote clu-doc-find-symbol)) (define-key help-map clu-doc-general-key (quote clu-doc-find-topic)) (define-key help-map clu-doc-apropos-key (quote clu-doc-find-apropos)) (defun clu-doc-help nil "\ Print help on using the on-line CLU manual" (interactive) (byte-code "Ĉ!\"Oʐ!!!!!! !!!! !!!! !!!!!!!!!!!!!!!!!!!!!!!! )" [help-key clu-doc-symbol-key clu-doc-general-key clu-doc-apropos-key nil substitute-command-keys "\\[help-for-help]" 0 string-match " " "*Help*" princ "The CLU on-line manual " "====================== " " To get CLU help, type " " (help key) followed by one of the keys: " " '" "' - " "documentation on a CLU type or operation (e.g., REAL, stream$copy)" "general CLU topic (e.g., CLUSTERS, input/output, SYNTAX)" "CLU apropos, all entries matching some string (e.g. file)" " Note: case is unimpotrtant, use TAB for completion, word under cursor is " "given as a default (if such entry exists). " " To add user defined abstractions to the manual, see description of the " "following functions (type " "\\[describe-function]" " and give the function name): " " clu-doc-add-file (add spec of a CLU file to current help) " " clu-doc-add-directory (add spec of all CLU files in a directory) " " clu-doc-dump-file (append spec of a CLU file to a dump file) " " clu-doc-load-file (load a dump file into current help) " " clu-doc-total-dump (create a new version of CLU-DOC) " " or the variables (type " "\\[describe-variable]" " and give the variable name): " " clu-doc-file-suffix (recognize files as CLU files) " " clu-doc-dumped-files-to-load (files loaded at initialization) " " Note: Adding CLU files or loading dumped files affects the current session " "of the CLU help only! Set clu-doc-dumped-files-to-load in your .emacs to " "the list of dumped files you need regularly." print-help-return-message] 43)) (defun clu-doc-snarf-file (file) "\ Takes a clu-doc FILE, records the pointers into that file, and writes out a list of doc pointers into FILE-keys.el. The list is suitable for the clu-doc-find-entry command." (interactive "FMake -keys.el for file: ") (byte-code "È!eb#O`! \\!`\" B E BK B $   -" [file temp symbol-list nil general-list general entry clu-doc-start t clu-doc-key-length clu-symbols-doc clu-general-doc find-file search-forward looking-at "GD" buffer-substring forward-sexp 1 clu-doc-dump-keys "snarf"] 10)) (defun clu-doc-dump-keys (file symbol-list general-list which-one) "\ Dump the two lists in the keys.el file for the doc FILE" (byte-code "!qc\"c \"c !ccc !cc P!)" [which-one file symbol-list general-list generate-new-buffer "-keys.el" ";; This file is generated automatically by clu-doc-" insert "-file" " ; it contains ;; pointers to entries in the file " " . " "(setq clu-symbols-doc '" prin1-to-string ") " "(setq clu-general-doc '" ")" write-file] 8)) (defun clu-doc-visit-file (file) (interactive (byte-code "P$C" [default-directory t read-file-name "Visit clu doc table: (default CLU-DOC) " "CLU-DOC"] 5)) (byte-code "ƈ ! ! P !?\" \"R P  !?7P \" !D !H \" \"!)" [default-directory t file keys-file clu-doc-file-name clu-doc-dumped-files-to-load nil expand-file-name file-directory-p "CLU-DOC" file-readable-p error "File %s in not readable." "-keys.el" file-exists-p "File %s does not exist. Use " "clu-doc-snarf-file to generate it" load mapcar clu-doc-load-file message " "] 12)) (defun require-doc-file-in-buffer nil (byte-code "!  ? P$! ! 4 !q! !)" [nil clu-doc-file-name default-directory t clu-doc-buffer boundp clu-symbols-doc clu-doc-visit-file read-file-name "Visit clu doc table: (default CLU-DOC) " "CLU-DOC" find-file-noselect rename-buffer "*CLU-DOC*"] 9)) (defun clu-print-match (arg) "\ Prints symbols in ARG matching clu-match-apropos (passed dynamically)" (byte-code " @!\"! @! ȇ" [clu-match-apropos arg t string-match upcase princ " " terpri nil] 6)) (defun clu-doc-find-apropos (test) "\ Show all Clu symbols and topics whose names contain match for TEST" (interactive "sApropos CLU doc string: ") (byte-code "Ĉ Ɛ !! \" ! \" " [clu-match-apropos test clu-symbols-doc clu-general-doc nil require-doc-file-in-buffer "*Help*" upcase princ "Matching CLU symbols found:" terpri mapcar clu-print-match "Matching CLU documentation topics found:" print-help-return-message] 12)) (defun clu-doc-find-symbol nil "\ Ask for a Clu symbol. Return documentation as a Clu type or operation." (interactive) (byte-code "!" [nil clu-doc-find-entry symbols] 2)) (defun clu-doc-find-topic nil "\ Ask for a Clu topic (e.g. TERMINAL_I/O) . Return documentation." (interactive) (byte-code "!" [nil clu-doc-find-entry general] 2)) (defun clu-doc-find-entry (option) "\ Based on OPTION ('symbols or 'general), ask and return Clu documentation." (byte-code " = =Ղ`     ُ b F ! \"MÉ  ] RaP $\"  ! \"  ! \"  ! \"  \")q Ab!!!! !! !! ! !!!!S!&!S!2!S!>!S!J!S!S!!` k@A!r@B!C!D `\"!E @B!E ` @dF#C!D `\"!G ). " [completion-ignore-case t till-dollar nil clu-table option clu-symbols-doc clu-general-doc prompt current-word result from-point to-point keep-point symbol clu-doc-buffer clu-doc-edit clu-doc-start require-doc-file-in-buffer symbols general "Describe CLU topic" "Describe CLU symbol" er (byte-code "! !!`!`) \"!W!#8!`!` VI `S \" P" [from-point to-point current-word looking-at "\\$" forward-char 1 forward-sexp -1 buffer-substring re-search-backward "[^a-z_A-Z]" beg-buf re-search-forward "\\[" error] 14) ((error (byte-code "" [nil] 1))) assoc upcase " (default " "): " ": " completing-read equal "" error "No default for CLU symbol" downcase "case mix up: %s not in clu-table keys" set-fill-column 79 display-buffer "*Help*" looking-at "B" princ "Built-in " "U" "User defined " "O" "Operation on " "GD" "General Documentation about: " forward-char 1 "T" "type: " "C" "type class: " "Built-in type: " "User defined type: " "P" "procedure: " "I" "iterator: " re-search-forward "\\$" " " -1 buffer-substring terpri to-end print-help-return-message] 51)) (defvar clu-doc-temp-buffer "*clu-temp*" "\ Name of clu-doc temp buffer") (defun goto-next-abstraction nil "\ Goto next occurance of = proc/iter/cluster . If not found then return nil, else return the type of abst. (string) and position cursor at begining of line of identifier" (byte-code " &#3`!`T\"b! ," [abst-regexp bol identifier sep abstraction result nil from-point to-point t concat "=" re-search-forward re-search-backward "[ = ]" buffer-substring] 7)) (defun get-next-identifier nil "\ Starting from current point, move forward and return next identifier. If current point is in middle of identifier ID, return rest of ID" (byte-code "!`S!`S\"*" [from-point to-point nil re-search-forward "[a-z_A-Z]" "[^0-9a-zA-Z_]" buffer-substring] 5)) (defun handle-proc (start-point internal) "\ Handle procedure defined after START-POINT (== current point). INTERNAL, if non-nil, is the name of the cluster" (byte-code "  ! ?!Q!& !!%! Q#?8#`b!! #T! #`! P \" `\"!*" [name eop clu-doc-start internal bol nil t start-point identifier get-next-identifier princ "UP" upcase " " concat "OU" "$" re-search-forward "end[ ]+" error "Procedure %s does not terminate with \"end %s\"" "\\bproc\\b" forward-sexp 1 "\\breturns\\b" "\\bsignals\\b" beginning-of-line buffer-substring] 22)) (defun handle-iter (start-point internal) "\ Handle iterator defined after START-POINT (== current point). INTERNAL, if non-nil, is the name of the cluster" (byte-code "  ! ?!Q!& !!%! Q#?8#`b!! #T! #`! P \" `\"!*" [name eoi clu-doc-start internal bol nil t start-point identifier get-next-identifier princ "UI" upcase " " concat "OU" "$" re-search-forward "end[ ]+" error "Iterator %s does not terminate with \"end %s\"" "\\biter\\b" forward-sexp 1 "\\byields\\b" "\\bsignals\\b" beginning-of-line buffer-substring] 22)) (defun get-ops (ops) "\ Return list of cluster operations. Set variable end-point dynamically" (byte-code "! ! R! ` SP!; R! ` SP!M! !S B!" [sep identifier end-point ops bol t looking-at "[ ]*\\(%\\| \\)" re-search-forward " " "=" "where\\b" beginning-of-line "," get-ops get-next-identifier] 13)) (defun handle-cluster (start-point) (byte-code "  !R!Q#?%#`b!!;!! !! \"! ??b @ R #?p @# P! @P!`\" P! @P!`\" @# AP b," [cluster-name ops nil end-point eoc clu-doc-start bol t start-point sep get-next-identifier princ "UT" upcase " " re-search-forward "end[ ]+" error "Cluster %s does not terminate with \"end %s\"" "\\bcluster\\b" looking-at "[ ]*\\[" forward-sexp 1 "\\bis\\b" nreverse get-ops buffer-substring "=" "Operation %s declared but not found inside cluster %s" "proc" re-search-backward handle-proc "iter" handle-iter "Expecting iter or proc %s but not found in cluster %s"] 26)) (defun clu-doc-add-directory (dname) "\ Add specifications of all the Clu files in directory DNAME to the current session of the CLU manual on-line help facility. The Clu files are all the files whose suffix matches clu-doc-file-suffix" (interactive "DGive name of directory with CLU files: ") (byte-code "Ĉ P#\" \")" [files dname t clu-doc-file-suffix nil directory-files "$" mapcar clu-doc-add-file message "Done adding CLU files from directory %s "] 5)) (defun clu-doc-add-file (fname) "\ Takes a syntactically correct Clu file FNAME, extracts the specifications and adds them to the current session of the Clu help facility." (interactive "fGive name of CLU file: ") (byte-code "ˆ! !\"" [fname clu-doc-temp-buffer nil clu-doc-parse-file clu-doc-load-buffer message "File %s added to current CLU manual."] 5)) (defun clu-doc-parse-file (fname) "\ Take name of CLU file (FNAME), and extract its specifications (in CLU-DOC format) into clu-doc-temp-buffer (erasing previous contents in this buffer)." (byte-code " ! !   qeb̉  ] \"A`\"Y \"O`\"Y \"Y`!,)?h !. " [file-is-loaded fname buf temp-buffer-show-hook type from-point code-point bol sep identifier abstraction case-fold-search t clu-doc-temp-buffer nil get-buffer find-file-noselect (lambda (b) (byte-code "" [nil] 1)) "^[ ]*" "[ ]*" "[a-z_A-Z][a-zA-Z_0-9]*" "\\(proc\\|iter\\|cluster\\)\\b" goto-next-abstraction equal "proc" handle-proc "iter" handle-iter "cluster" handle-cluster kill-buffer] 12)) (defun clu-doc-load-buffer (doc-buf) "\ DOC-BUF should contain file in CLU-DOC format. Adds DOC-BUF contents into the current CLU manual" (byte-code " q‰db` !! b #G`!`! `\"B B " [clu-doc-buffer buffer-auto-save-file-name nil from-point doc-buf clu-doc-start t code-point clu-doc-key-length clu-symbols-doc require-doc-file-in-buffer insert-buffer set-buffer-modified-p search-forward forward-char forward-sexp 1 buffer-substring] 10)) (defun clu-doc-load-file (dumped-file) "\ Load DUMPED-FILE into the current session of the CLU manual. DUMPED-FILE should have been created by clu-doc-dump-file" (interactive "fGive name of a CLU dump file: ") (byte-code "È!!! ! ? !\"*" [dumped-file file-is-loaded buf nil expand-file-name get-buffer find-file-noselect clu-doc-load-buffer kill-buffer message "Done loading CLU dump file %s"] 8)) (defun clu-doc-dump-file (clu-file dump-file) "\ Extracts specifications from CLU-FILE and appends them to DUMP-FILE (in CLU-DOC format). DUMP-FILE can be later loaded using M-x clu-doc-load-file. Asks user whether these specifications should also be added to the current session of the Clu manual." (interactive "fGive name of a CLU file: FFile to append this dump to: ") (byte-code "Ĉ! qed %)! ! #" [clu-file clu-doc-temp-buffer dump-file t nil clu-doc-parse-file write-region no-show y-or-n-p "Also add to current CLU manual? " clu-doc-load-buffer message "Dumped specifications of CLU file %s into %s"] 8)) (defun clu-doc-total-dump (dfile) "\ Dump the whole current Clu help manual into a new DFILE, also generate -keys.el file. The new DFILE can be used later in lieu of CLU-DOC file" (interactive "FGive name for a new CLU DOC file: ") (byte-code "Ĉ!!\" q! $)" [dfile clu-doc-buffer clu-symbols-doc clu-general-doc nil expand-file-name file-exists-p error "File %s exists! Aborting." require-doc-file-in-buffer write-file clu-doc-dump-keys "dump"] 10))