kramer (01/06/83)
The following is a list of things that I would like to see in emacs: 1) that undo be
clives (01/08/83)
A second for undo; it's been undone far too long.
hansen (01/14/83)
The following is about as close to an mlisp compiler as we'll probably get
for a while. It is called squeeze. It takes an mlisp file named foo.ml and
creates another file called foo. This new file has just about ALL extraneous
garbage taken out of it. This HAS been sent to James Gosling for inclusion
in the next release.
To receive the maximum benefits from it, change all "load"'s and
"auto-load"'s in your system profile.ml and each user's ~/.emacs_pro.ml from
loading in "foo.ml" into loading in "foo". Then "squeeze" as many of the .ml
files as possible. Note that I said ~/.emacs_pro.ml above. This implied that
your initialization profile should be squeezed as well.
Sincerely,
Tony Hansen
pegasus!hansen
P.S. Has this newsgroup been gatewayed into unix-emacs@cmu-a yet?
P.S.S. A few articles ago I saw a wish for undo to be done. Well, you
evidently don't have the latest release because undo was done last October.
--> squeeze.ml <--
;;;; LastEditDate="Tue Oct 19 11:36:46 1982"
;;;;
;;;; Squeeze.ml
;;;; Written by Tony Hansen.
;;;;
;;;; Take an mlisp file and remove all extraneous stuff
;;;; from it, then writes the file out.
;;;;
;;;; I think that this is as close as we will get to a
;;;; compiler for mlisp functions.
;;;;
;;;; By convention, this file name should be the file's
;;;; name without the .ml extension, and you will get that
;;;; if you just type return.
;;;;
;;;; It is assumed that dot starts in the file you want
;;;; squeezed down.
(defun
(squeeze-mlisp-file
filename ; current file name
sfilename ; squeezed file name
default-sfilename ; default squeezed fn
bufname ; current buffer name
sbufname ; squeeze buffer name
fc ; following char
watch ; watch it being done
(setq filename (current-file-name)) ; fill in values
(setq bufname (current-buffer-name)) ; ....
(if prefix-argument-provided ; ....
(setq watch 1) ; ....
(setq watch 0)) ; ....
(save-restriction old-mod-flag ; get squeezed file name
(setq old-mod-flag buffer-is-modified) ; ....
(set-mark) ; ....
(narrow-region) ; ....
(insert-string filename) ; ....
(error-occured (search-reverse "/")) ; .... find basename
(if (error-occured (search-forward ".")) ; .... any suffix?
(setq default-sfilename "No default") ; ....
(progn (end-of-line) ; .... remove suffix
(search-reverse ".") ; ....
(setq default-sfilename ; ....
(region-to-string)))) ; ....
(erase-buffer) ; .... clean up
(setq buffer-is-modified old-mod-flag)) ; ....
(setq sfilename ; .... ask user
(get-tty-string ; ....
(concat "File to write out to [" ; ....
default-sfilename "]? "))) ; ....
(if (& (= sfilename "") ; .... give default
(= default-sfilename "No default")) ; ....
(setq sfilename "/dev/null") ; ....
(setq sfilename default-sfilename)) ; ....
(save-window-excursion
(error-occured ; visit squeezed file
(visit-file sfilename))
(setq sbufname ; save buffer name
(current-buffer-name))
(erase-buffer) ; erase old contents
(yank-buffer bufname) ; get .ml version
(beginning-of-file)
(while (! (eobp))
(if watch (sit-for 0)) ; let us watch
(delete-white-space) ; leading spaces
(while (! (eolp))
(setq fc (following-char))
(if (= fc '(') ; skip left paren
(forward-character)
(= fc ')') ; skip right paren
(progn (if (= (preceding-char) '^J')
(delete-previous-character))
(forward-character))
(= fc '"') ; quoted string
(progn (delete-white-space)
(if (! (bolp))
(insert-character ' '))
(forward-to-double-quote))
(= fc '\'') ; quoted char
(progn (delete-white-space)
(if (! (bolp))
(insert-character ' '))
(forward-to-single-quote))
(| (= fc ' ') ; white space
(= fc '^I'))
(progn (delete-white-space)
(if (! (bolp))
(insert-character ' ')))
(= fc ';') ; comment
(kill-to-end-of-line)
;else ; everything else
(skip-mlisp-word))
)
(delete-white-space) ; trailing spaces
(if (= (current-column) 1) ; on blank line?
(error-occured (delete-next-character))
(error-occured (forward-character))))
(if (!= (preceding-char) '^J') ; add nl at file end
(newline))
(beginning-of-file)
(write-named-file sfilename)) ; write out result
(delete-buffer sbufname) ; cleanup
(message filename " >>> " sfilename "!")
(novalue)
)
; skip over quoted string
(forward-to-double-quote quote in-string nextchar
(setq quote '"') ; which quote?
(setq in-string 1)
(forward-character) ; skip quote
(while in-string
(setq nextchar (following-char)) ; look at next char
(if (error-occured ; move over char
(forward-character))
(error-message "End of buffer found within string!"))
(if (= nextchar quote) ; end of string?
(if (= (following-char) quote) ; ... another quote?
(forward-character) ; ... skip it too
(setq in-string 0)) ; ... nope, the end
(= nextchar 92) ; backslash
(forward-character) ; ... skip next char
(= nextchar '^J') ; newline
(error-message "Newline found within string!")
)))
(forward-to-single-quote nextchar
(forward-character) ; skip quote
(setq nextchar (following-char))
(if (error-occured (forward-character)) ; skip next char
(error-message
"End of buffer found in character constant!"))
(if (= nextchar 92) ; backslash
(if (& (>= (following-char) '0')
(<= (following-char) '9'))
(while (& (>= (following-char) '0') ; skip number
(<= (following-char) '9'))
(forward-character))
(if (error-occured (forward-character)) ; skip next char
(error-message
"End of buffer found in character constant!")))
(= nextchar '^') ; control char?
(if (!= (following-char) '\'') ; skip next char
(if (error-occured (forward-character))
(error-message
"End of buffer found in character constant!"))
))
(if (!= (following-char) '\'') ; skip other quote
(error-message
"Improper character constant!")
(forward-character)))
; skip over mlisp word
(skip-mlisp-word
(if (error-occured ; find next white
(re-search-forward "[ \t\n()]")) ; ... space or parens
(end-of-line) ; oops, none there
(backward-character))) ; back up
)