LISTING FOR >spec>install>1136>emacs-macro-edit COMPILED BY Multics LISP Compiler, Version 2.13c, July 11, 1983 ON 08/20/86 2255.8 mst Wed IN BEHALF OF Martinson.SysMaint.a ;;; *********************************************************** ;;; * * ;;; * Copyright, (C) Honeywell Information Systems Inc., 1982 * ;;; * * ;;; * Copyright (c) 1978 by Massachusetts Institute of * ;;; * Technology and Honeywell Information Systems, Inc. * ;;; * * ;;; *********************************************************** ;;; ;;; ;;; Emacs keyboard macro editor ;;; February 16-18, 1979 by BSG ;;; Modified: 30 January 1984, Barmar: to fix parsing of ESC <+/->NUM. ;;; (%include e-macros) (declare (defpl1 date_time_af_ "date_time" (return char (26.) varying))) (declare (special fill-column macedit-whats-escape-today-vbl comment-prefix include-dir comment-column macedit-source-buffer)) (declare (*expr begin-defun find-file-subr find-key-in-buf get-key-binding get-key-name key-prompt kill-line-contents kmacro-display-interpret lisp-mode macomp-compile-to-expr macomp-output-to-buffer one-back-is-a parse-key-description)) (defun macedit-find-all-macros () (let ((l nil)) (mapatoms '(lambda (x) (let ((y (get x 'editor-macro))) (if y (setq l (cons (cons x y) l)))))) l)) ;Return the gotten list (defun macedit-display-all-macros-to-buffer () (mapc '(lambda (mac) (macedit-display-to-buffer (car mac)(cdr mac) (find-key-in-buf (car mac) macedit-source-buffer)) (new-line) (new-line)) (macedit-find-all-macros))) (defun macedit-display-to-buffer (fun list key) (insert-string (catenate "macro " fun)) (if key (insert-string (catenate " on " key))) (new-line) (insert-string " ") (mapc 'macedit-display-one-enmacroed-command-to-buffer (save-excursion-buffer (go-to-buffer macedit-source-buffer) (kmacro-display-interpret list))) (if (line-is-blank)(without-saving (kill-line-contents)) else (new-line)) (insert-string (catenate "end-macro " fun))) (defun macedit-display-one-enmacroed-command-to-buffer (comcons) (let ((key (car comcons)) (fun (cdr comcons))) (if (eq fun 'Input/ Characters) ;doublequote input chars (setq key (apply 'catenate (append '("." """") (mapcar '(lambda (x) (cond ((= x (CtoI """")) """""") (t (ItoC x)))) (exploden key)) '(""""))))) (if (> (+ 1 (stringlength key) (cur-hpos)) comment-column) (new-line) (insert-string " ") else (insert-string " ")) (insert-string key))) (defun macedit-find-beginning-of-macdef () (go-to-beginning-of-line) (do-forever (if (looking-at "macro")(stop-doing)) (if (firstlinep)(display-error "No macro definition found")) (prev-line))) (defun macedit-scan-atom () (macedit-skip-over-whitespace) (cond ((at-end-of-buffer) nil) ((looking-at ".""") (forward-char) (cons 'input-chars (macedit-scan-atom))) ((at '/" )(macedit-scan-quoted-string)) ((at '+) (forward-char) (macedit-scan-number)) ((at '-) (forward-char) (- (macedit-scan-number))) ((macedit-digitp (curchar)) (macedit-scan-number)) (t (with-mark begin (skip-to-whitespace) (intern (make_atom (point-mark-to-string begin))))))) (defun macedit-digitp (x) (or (numberp x)(setq x (CtoI x))) (and (> x (1- (CtoI "0")))(< x (1- (CtoI "9")))(- x (CtoI "0")))) (defun macedit-scan-number () (cond ((and (not (at-end-of-buffer)) (macedit-digitp (curchar))) (do ((acc 0) (dp (macedit-digitp (curchar)) (and (not (at-end-of-buffer)) (macedit-digitp (curchar))))) ((null dp) acc) (setq acc (+ (* 10. acc) dp)) (forward-char))) (t 1))) ;nothing, defaults to 1 (defun macedit-scan-quoted-string () (do ((s ""))(nil) (forward-char) (with-mark bos (if (forward-search """") (if-at '/" (backward-char) (setq s (catenate s (point-mark-to-string bos) """" )) (forward-char) else (backward-char) (setq s (catenate s (point-mark-to-string bos))) (forward-char) (release-mark bos) (return s)) else (go-to-mark bos) (release-mark bos) (display-error "Unbalanced string"))))) (defun macedit-skip-over-whitespace () (do-forever (skip-over-whitespace) (if (not (looking-at "/*"))(stop-doing)) (do-times 2 (forward-char)) (if (not (forward-search "*/")) (display-error "Unbalanced comment.")))) (defun macedit-produce-macro-definition () (prog (macname keyname mlist) (macedit-find-beginning-of-macdef) (or (eq (macedit-scan-atom) 'macro) (return '(nil . "Mangled macro definition"))) (setq macname (macedit-scan-atom)) (if (memq macname '(nil end-macro on)) (return '(nil . "Bad or empty macro definition"))) (macedit-skip-over-whitespace) (if (looking-at "on") ;Key given (macedit-scan-atom) (setq keyname (macedit-scan-atom))) (do ((x nil (nconc (macedit-scan-commands) x))) ((memq (car x) '(macend error)) (setq mlist x))) (if (eq (car mlist) 'error)(return (cadr mlist))) (if (not (eq macname (macedit-scan-atom))) (return '(nil . "Macro end does not match beginning"))) (return (list macname keyname (nreverse mlist))))) (defun macedit-scan-commands () (if (or (not (boundp 'macedit-whats-escape-today-vbl)) (null macedit-whats-escape-today-vbl)) (setq macedit-whats-escape-today-vbl (cadr (parse-key-description (find-key-in-buf 'escape macedit-source-buffer))))) ;Feelthy magic. (let ((atom (macedit-scan-atom))) (cond ((eq atom nil)(list 'error "Macro ran off end.")) ((eq atom 'end-macro)(list 'macend)) ((numberp atom)(nreverse (exploden (decimal-rep atom)))) ((symbolp atom) (if (and (> (stringlength atom) 5) (samepnamep (substr atom 1 5) "meta-")) (+ 200 (cadr (parse-key-description (substr atom 6)))) else (setq atom (parse-key-description atom)) (cond ((= (car atom) 1) ;escape char (list (cadr atom) (cons 'toplevel-char macedit-whats-escape-today-vbl))) ((caddr atom) ;prefix char (list (cadr atom)(cons 'toplevel-char (caddr atom)))) (t (list (cons 'toplevel-char (cadr atom))))))) ;no pfx, no esc ((stringp atom) (mapcar '(lambda (x)(cons 'toplevel-char x)) (nreverse (exploden atom)))) ((and (not (atom atom))(eq (car atom) 'input-chars)) (nreverse (exploden (cdr atom)))) (t (break macedit-scan-commands t))))) (defprop emacro macro-edit-mode suffix-mode) (defun macro-edit-mode () (setq current-buffer-mode 'Macro/ Edit) (establish-local-var 'macedit-source-buffer current-buffer) (mapc '(lambda (x)(set-key (car x)(cadr x))) '((ESC-^A macedit-find-beginning-of-macdef) (ESC-^B macedit-backward-term) (ESC-^C macedit-compile-to-lisp) (ESC-^E macedit-find-end-of-macdef) (ESC-^F macedit-forward-term) (ESC-^H macedit-mark-whole-macro) (ESC-^K macedit-kill-term) (ESC-^N macedit-forward-macdef) (ESC-^P macedit-backward-macdef) (ESC-^S macedit-state-keyboard-macro) (ESC-^Z macedit-take-up-definition))) (setq comment-prefix "/*" comment-column 51.)) (defun macedit-state-keyboard-macro () (let ((k (key-prompt "Macro Key: "))) (let ((f (save-excursion-buffer (go-to-buffer macedit-source-buffer) (get-key-binding k)))) (let ((l (get f 'editor-macro))) (if (null l) (display-error " " (get-key-name k) " is not a macro.")) (go-to-end-of-buffer) (macedit-display-to-buffer f l (get-key-name k)) (new-line))))) (defun macedit-take-up-definition () (macedit-find-beginning-of-macdef) (let ((mac (macedit-produce-macro-definition))) (if (car mac) (putprop (car mac)(caddr mac) 'editor-macro) (if (cadr mac)(set-perm-key (cadr mac)(car mac))) else (display-error-noabort (cdr mac))))) (defun load-these-macros () (go-to-beginning-of-buffer) (do-forever (macedit-skip-over-whitespace) (if (at-end-of-buffer)(stop-doing)) (if (looking-at "macro") (macedit-take-up-definition) else (display-error "Bad format in macro file")))) (defun load-macrofile (filepath) (save-excursion-buffer (load-macrofile- filepath))) (defun load-macrofile- (filepath) (let ((thatbuf current-buffer)) (find-file-subr filepath) (macro-edit-mode) (setq macedit-source-buffer thatbuf) (load-these-macros) (go-to-beginning-of-buffer))) (defun edit-macrofile () (load-macrofile- (trim-minibuf-response "Edit Macro File: " NL))) (defun edit-macros () (let ((thatbuf current-buffer)) (go-to-or-create-buffer 'emacs-macros) (if (empty-buffer-p current-buffer) (insert-string "/* Emacs macros ") (with-mark m (insert-string (date_time_af_)) (go-to-mark m) (insert-string (prog2 0 (macedit-scan-quoted-string) (go-to-mark m) (without-saving (kill-to-end-of-line))))) (insert-string " */") (do-times 2 (new-line)) (macro-edit-mode) else (go-to-end-of-buffer)) (setq macedit-source-buffer thatbuf) (save-excursion (macedit-display-all-macros-to-buffer)))) ;;; ;;; Crufty lispmode-like functions ;;; (defprop macedit-forward-term t argwants) (defun macedit-forward-term () (macedit-skip-over-whitespace) (if (not (at-end-of-buffer)) (macedit-scan-atom))) (defprop macedit-forward-macdef t argwants) (defun macedit-forward-macdef () (if (and (bolp)(looking-at "macro")) (macedit-scan-atom)) (do-forever (macedit-skip-over-whitespace) (if (at-end-of-buffer)(stop-doing)) (if (and (bolp)(looking-at "macro")) (stop-doing)) (macedit-scan-atom))) (defun macedit-find-end-of-macdef () (macedit-find-beginning-of-macdef) (do-forever (if (eq (macedit-scan-atom) 'end-macro) (macedit-scan-atom) (go-to-end-of-line) (stop-doing)) (if (at-end-of-buffer)(stop-doing)))) (defun macedit-mark-whole-macro () (macedit-find-beginning-of-macdef) (set-the-mark) (macedit-find-end-of-macdef)) (defprop macedit-kill-term forward kills) (defprop macedit-kill-term t argwants) (defun macedit-kill-term () (with-mark m (macedit-forward-term) (wipe-point-mark m))) (defun macedit-skip-back-whitespace () (do-forever (skip-back-whitespace) (if (at-beginning-of-buffer)(stop-doing)) (if-back-at '// (if (one-back-is-a '*) (if (not (reverse-search "/*")) (display-error "Unbalanced comment.")) else (stop-doing)) else (stop-doing)))) (defprop macedit-backward-term t argwannts) (defun macedit-backward-term () (macedit-skip-back-whitespace) (if-back-at '/" (macedit-skip-back-quoted-string) else (skip-back-to-whitespace))) (defun macedit-skip-back-quoted-string () (do-forever (backward-char) (if (not (reverse-search """")) (display-error "Unbalanced string.")) (if-back-at '/" nil else (stop-doing))) (if-back-at '/. (backward-char))) (defun macedit-backward-macdef () (if (firstlinep)(go-to-beginning-of-line) else (if (and (bolp)(looking-at "macro")) (backward-char)) (macedit-find-beginning-of-macdef))) ;;; ;;; Here's some new ground ... ;;; Automatic Lisp-program writing. ;;; BSG 2/18/79 (defun macedit-compile-to-lisp () (macedit-find-beginning-of-macdef) (let ((mac (macedit-produce-macro-definition))) (if (null (car mac)) (display-error "Syntax error: " (cdr mac))) (let ((interp (save-excursion-buffer (go-to-buffer macedit-source-buffer) (kmacro-display-interpret (caddr mac))))) (go-to-or-create-buffer (intern (make_atom (catenate macedit-source-buffer ".e-macros.lisp")))) (if (empty-buffer-p current-buffer)(lisp-mode) (macomp-output-to-buffer '(%include e-macros)) (insert-string ";;; e-macros.incl.lisp is found in ") (insert-string include-dir) (do-times 2 (new-line)) else (go-to-end-of-buffer)) (if (cadr mac) (macomp-output-to-buffer (list 'set-perm-key (get_pname (cadr mac)) (list 'quote (car mac))))) (macomp-output-to-buffer (macomp-compile-to-expr (car mac) interp)) (new-line) (begin-defun)))) (define-autoload-lib emacs-macro-compile macomp-output-to-buffer macomp-compile-to-expr) INCLUDE FILE >spec>install>1136>executable>e-macros.incl.lisp ;;; BEGIN INCLUDE FILE e-macros.incl.lisp ;;; Declares for use by Emacs programs and extenstions. Also loads ;;; in e_macros_, which contains macro definitions. ;;; HISTORY COMMENTS: ;;; 1) change(85-01-01,Margolin), approve(86-02-24,MCR7186), ;;; audit(86-08-12,Harvey), install(86-08-20,MR12.0-1136): ;;; Written: New Year's Day 1985, by excerpting the old e-macros.incl.lisp ;;; and leaving out all the definitions and qwerty junk (don't ask). ;;; 2) change(86-02-24,Margolin), approve(86-02-24,MCR7325), ;;; audit(86-08-12,Harvey), install(86-08-20,MR12.0-1136): ;;; Alphabetized declarations, and added more declarations for documented ;;; functions, and also for some undocumented functions. ;;; END HISTORY COMMENTS (%include backquote) (declare ;basic editor stuff (*expr apply-catenate assert-minor-mode backward-char backward-n-chars charlisten charset-member command-abort command-quit copy-region cur-hpos curline-as-string curbuf-as-string curchar curline-as-string delete-char delete-word destroy-buffer-contents dont-notice-modified-buffer e_cline_ e_lap_$reverse-search-string e_lap_$trim empty-buffer-p error_table_ establish-local-var exchange-point-and-mark firstlinep forward-char forward-n-chars forward-regexp-search-in-line forward-search forward-search-in-line get-char get-search-string go-to-beginning-of-buffer go-to-beginning-of-line go-to-buffer go-to-end-of-buffer go-to-end-of-line go-to-hpos go-to-mark go-to-or-create-buffer insert-char insert-string kill-backwards-to-mark kill-forward-to-mark kill-pop kill-to-end-of-line killsave-string lastlinep loadfile looking-at lowercase map-over-emacs-commands mark-on-current-line-p mark-reached merge-kills-forward merge-kills-reverse move-mark minibuf-response minibuffer-clear negate-minor-mode new-line next-line nullstringp pathname_ pathname_$component point-mark-to-string point>markp prev-line printable process-char produce-named-mark-list read-in-file release-mark reverse-search register-local-var reverse-search-in-line search-back-first-charset-line search-back-first-not-charset-line search-failure-annunciator search-for-first-charset-line search-for-first-not-charset-line set-emacs-epilogue-handler set-buffer-self-destruct set-key set-mark-here set-mark set-perm-key set-the-mark set-the-mark-here skip-to-whitespace skip-to-whitespace-in-line wipe-point-mark wipe-region write-out-file trim-minibuf-response yesp yank) (*fexpr define-autoload-lib)) (declare ;redisplay stuff (*expr end-local-displays init-local-displays ring-tty-bell local-display-generator local-display-generator-nnl next-screen prev-screen local-display-current-line find-buffer-in-window select-buffer-window window-info select-buffer-find-window select-other-window select-window buffer-on-display-in-window redisplay full-redisplay)) (declare ;extended stuff (*expr forward-word backward-word skip-over-whitespace skip-back-whitespace skip-over-whitespace-in-line skip-back-whitespace-in-line skip-back-to-whitespace skip-to-whitespace rubout-char date display-buffer-as-printout delete-white-sides lefthand-char format-to-col whitespace-to-hpos line-is-blank decimal-rep register-option minibuffer-clear)) (declare (*lexpr display-error display-com-error display-error-noabort display-error-remark comout-get-output display-com-error-noabort minibuffer-print minibuffer-response trim-minibuffer-response intern-minibuffer-response minibuffer-remark minibuffer-print-noclear report-error report-error-noabort)) (declare (special TAB NL SPACE ESC curpointpos current-buffer dont-stash numarg der-wahrer-mark fpathname fill-column completion-list curlinel BACKSPACE read-only-flag buffer-modified-flag previous-buffer current-buffer-mode env-dir process-dir minibuffer-end-string NLCHARSTRING undo null-pointer)) ;;; Load in macro packages (eval-when (eval compile) (or (status feature e-defcom) (progn (load (catenate (car (namelist (truename infile))) ">e_define_command_")) (sstatus feature e-defcom))) (or (status feature e-macros) (load (catenate (car (namelist (truename infile))) ">e_macros_")))) ;;; END INCLUDE FILE e-macros.incl.lisp INCLUDE FILE >ldd>include>backquote.incl.lisp ;;; ;;; backquote.incl.lisp - BSG 10/9/79 ;;; Loads lisp_backquote_ into either the compiler or interpreter ;;; environment. ;;; ;;; Modified 10/30/82 by Richard Lamson to use eval-when and ;;; (status feature backquote) ;;; (eval-when (eval compile) (or (status feature backquote) (load (catenate (car (namelist (truename infile))) ">lisp_backquote_")))) Functions Defined Name Offset Offset Name date_time_af_ 0 0 date_time_af_ edit-macrofile 2102 24 macedit-find-all-macros edit-macros 2113 150 macedit-display-all-macros-to-buffer load-macrofile 2032 210 macedit-display-to-buffer load-macrofile- 2064 336 macedit-display-one-enmacroed-command-to-buffer load-these-macros 2000 465 macedit-find-beginning-of-macdef macedit-backward-macdef 2517 510 macedit-scan-atom macedit-backward-term 2460 633 macedit-digitp macedit-compile-to-lisp 2540 657 macedit-scan-number macedit-digitp 633 750 macedit-scan-quoted-string macedit-display-all-macros-to-buffer 150 1065 macedit-skip-over-whitespace macedit-display-one-enmacroed-command-to-buffer 336 1126 macedit-produce-macro-definition macedit-display-to-buffer 210 1245 macedit-scan-commands macedit-find-all-macros 24 1564 macro-edit-mode macedit-find-beginning-of-macdef 465 1630 macedit-state-keyboard-macro macedit-find-end-of-macdef 2341 1733 macedit-take-up-definition macedit-forward-macdef 2277 2000 load-these-macros macedit-forward-term 2262 2032 load-macrofile macedit-kill-term 2367 2064 load-macrofile- macedit-mark-whole-macro 2363 2102 edit-macrofile macedit-produce-macro-definition 1126 2113 edit-macros macedit-scan-atom 510 2262 macedit-forward-term macedit-scan-commands 1245 2277 macedit-forward-macdef macedit-scan-number 657 2341 macedit-find-end-of-macdef macedit-scan-quoted-string 750 2363 macedit-mark-whole-macro macedit-skip-back-quoted-string 2470 2367 macedit-kill-term macedit-skip-back-whitespace 2420 2420 macedit-skip-back-whitespace macedit-skip-over-whitespace 1065 2460 macedit-backward-term macedit-state-keyboard-macro 1630 2470 macedit-skip-back-quoted-string macedit-take-up-definition 1733 2517 macedit-backward-macdef macro-edit-mode 1564 2540 macedit-compile-to-lisp Functions Referenced CtoI go-to-end-of-buffer macedit-skip-back-whitespace ItoC go-to-end-of-line macedit-skip-over-whitespace append go-to-mark macedit-take-up-definition apply go-to-or-create-buffer macomp-compile-to-expr backward-char insert-string macomp-output-to-buffer begin-defun intern macro-edit-mode break key-prompt make_atom catenate kill-line-contents nconc catenate kill-to-end-of-line new-line cur-hpos kmacro-display-interpret nreverse curchar lastlinep one-back-is-a date_time_af_ lefthand-char parse-key-description decimal-rep line-is-blank point-mark-to-string display-error lisp-mode prev-line display-error load-macrofile- putprop display-error load-these-macros release-mark display-error-noabort looking-at reverse-search empty-buffer-p macedit-digitp samepnamep establish-local-var macedit-display-all-macros-to-buffer set-key exploden macedit-display-one-enmacroed-command-to-buffer set-mark find-file-subr macedit-display-to-buffer set-perm-key find-key-in-buf macedit-find-all-macros set-the-mark firstlinep macedit-find-beginning-of-macdef skip-back-to-whitespace forward-char macedit-find-end-of-macdef skip-back-whitespace forward-search macedit-forward-term skip-over-whitespace get macedit-produce-macro-definition skip-to-whitespace get-key-binding macedit-scan-atom stringlength get-key-name macedit-scan-commands substr get_pname macedit-scan-number substr go-to-beginning-of-buffer macedit-scan-quoted-string trim-minibuf-response go-to-beginning-of-line macedit-skip-back-quoted-string wipe-point-mark go-to-buffer ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved