;; -*-Emacs-Lisp-*-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; File: efs-defun.el;; Release: $efs release: 1.20pre2 $;; Version: #Revision: 1.1 $;; RCS: ;; Description: efs-defun allows for OS-dependent coding of functions;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>;; Created: Thu Oct 22 17:58:14 1992;; Modified: Sun Nov 27 12:18:35 1994 by sandy on gandalf;; Language: Emacs-Lisp;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; This file is part of efs. See efs.el for copyright;;; (it's copylefted) and warranty (there isn't one) information.;;; efs-defun allows object-oriented emacs lisp definitions.;;; In efs, this feature is used to support multiple host types.;;; ;;; The first arg after the function name is a key which determines;;; which version of the function is being defined. Normally, when the function;;; is called this key is given as the first argument to the function.;;;;;; For example:;;; ;;; (efs-defun foobar vms (x y);;; (message "hello vms world");;; (+ x y));;; => foobar;;;;;; (foobar 'vms 1 2);;; => 3;;; The key nil plays a special role: ;;;;;; First, it defines a default action. If there is no function;;; definition associated with a given OS-key, then the function;;; definition associated with nil is used. If further there is no;;; function definition associated with nil, then an error is;;; signaled. ;;;;;; Second, the documentation string for the function is the one given;;; with the nil definition. You can supply doc-strings with other;;; definitions of the function, but they are not accessible with;;; 'describe-function. In fact, when the function is either loaded or;;; byte-compiled, they are just thrown away.;;; There is another way to define the default action of an efs-function.;;; This is with the use flag. If you give as the key (&use foobar),;;; then when the function is called the variable foobar will be used to;;; determine which OS version of the function to use. As well as;;; allowing you to define the doc string, if the use flag is used,;;; then you can specify an interactive specification with the function.;;; Although a function is only interactive, if the default definition;;; has an interactive spec, it is still necessary to give interactive;;; specs for the other definitions of the function as well. It is possible;;; for these interactive specs to differ.;;; ;;; For example:;;; ;;; (efs-defun fizzle (&use foobar);;; "Fizzle's doc string.";;; (interactive);;; (message "fizz wizz"));;; ;;; (efs-defun fizzle vms;;; (interactive);;; (message "VMS is fizzled."));;; ;;; (setq foobar 'unix);;; => unix;;; ;;; (fizzle);;; => "fizz wizz";;; ;;; (setq foobar 'vms);;; => vms;;; ;;; (fizzle);;; => "VMS is fizzled.";;; ;;; M-x f i z z l e <return>;;; => "VMS is fizzled.";;;;;; Actually, when you use the &use spec, whatever follows it is simply;;; evaluated at call time.;;; Note that when the function is defined, the key is implicitly;;; quoted, whereas when the function is called, the key is;;; evaluated. If this seems strange, think about how efs-defuns;;; are used in practice.;;; There are no restrictions on the order in which the different OS-type;;; definitions are done.;;; There are no restrictions on the keys that can be used, nor on the;;; symbols that can be used as arguments to an efs-defun. We go;;; to some lengths to avoid potential conflicts. In particular, when;;; the OS-keys are looked up in the symbol's property list, we;;; actually look for a symbol with the same name in the special;;; obarray, efs-key-obarray. This avoids possible conflicts with;;; other entries in the property list, that are usually accessed with;;; symbols in the standard obarray.;;; The V19 byte-compiler will byte-compile efs-defun's.;;; The standard emacs V18 compiler will not, however they will still;;; work, just not at byte-compiled speed.;;; efs-autoload works much like the standard autoload, except it;;; defines the efs function cell for a given host type as an autoload.;;; The from-kbd arg only makes sense if the default action of the autoload;;; has been defined with a &use.;;; To do:;;;;;; 1. Set an edebug-form-hook for efs-defun;;; Known Bugs:;;;;;; 1. efs-autoload will correctly NOT overload an existing function;;; definition with an autoload definition. However, it will also;;; not overload a previous autoload with a new one. It should. An;;; overload can be forced for the KEY def of function FUN by doing;;; (put 'FUN (intern "KEY" efs-key-obarray) nil) first.;;;;;; Provisions and requirements(provide'efs-defun)(require'backquote);;; Variables(defconstefs-defun-version(concat(substring"$efs release: 1.20pre2 $"14-2)"/"(substring"#Revision: 1.1 $"11-2)))(defconstefs-key-obarray(make-vector70));; Unfortunately, we need to track this in bytecomp.el.;; It's not much to keep track of, although.(defconstefs-defun-bytecomp-buffer"*Compile-Log*")(defvarefs-keynil"Inside an efs function, this is set to the key that was used tocall the function. You can test this inside the default definition, todetermine which key was actually used.")(defvarefs-argsnil"Inside an efs function, this is set to a list of the calling argsof the function.");;; Utility Functions;;; These functions are called when the macros efs-defun and efs-autoload;;; are expanded. Their purpose is to help in producing the expanded code.(defunefs-defun-arg-count(list);; Takes a list of arguments, and returns a list of three;; integers giving the number of normal args, the number;; of &optional args, and the number of &rest args (this should;; only be 0 or 1, but we don't check this).(let((o-leng(length(memq'&optionallist)))(r-leng(length(memq'&restlist)))(leng(lengthlist)))(list(-leng(maxo-lengr-leng))(max0(-o-lengr-leng1))(max0(1-r-leng)))));; For each efs-function the property efs-function-arg-structure;; is either a list of three integers to indicate the number of normal,;; optional, and rest args, or it can be the symbol 'autoload to indicate;; that all definitions of the function are autoloads, and we have no;; idea of its arg structure.(defunefs-defun-arg-check(funkeylist);; Checks that the LIST of args is consistent for the KEY def;; of function FUN.(let((prop(getfun'efs-function-arg-structure))count)(if(eqlist'autoload)(orprop(putfun'efs-function-arg-structure'autoload))(setqcount(efs-defun-arg-countlist))(if(andprop(not(eqprop'autoload))(not(equalpropcount)))(let((warning(format"args. for the %s def. of %s don't agree with previous defs."keyfun)))(message(concat"Warning: "warning));; We are compiling, I suppose...(if(get-bufferefs-defun-bytecomp-buffer)(save-excursion(set-bufferefs-defun-bytecomp-buffer)(goto-char(point-max))(insert"efs warning:\n "warning"\n")))))(putfun'efs-function-arg-structurecount))))(defunefs-def-generic(funusedoc-stringinteractive-p);; Generates a generic function def using USE.;; If use is nil, the first arg of the function;; is the key.(let((def-args'(&restefs-args))result)(oruse(setqdef-args(cons'efs-keydef-args)))(setqresult(`(or(get(quote(,fun))(,(ifuse(list'intern(list'symbol-nameuse)'efs-key-obarray)'(intern(symbol-nameefs-key)efs-key-obarray))))(get(quote(,fun))(intern"nil"efs-key-obarray)))));; Make the gen fun interactive, if nec.(setqresult(ifinteractive-p(`((interactive)(if(interactive-p)(let((prefix-argcurrent-prefix-arg))(call-interactively(,result)))(,(cons'apply(listresult'efs-args))))))(list(cons'apply(listresult'efs-args)))))(ifdoc-string(setqresult(consdoc-stringresult)))(cons'defun(consfun(consdef-argsresult)))))(defunefs-def-autoload(funkeyfilefrom-kbd);; Returns the autoload lambda for FUN and FILE.;; I really should have some notion of efs-autoload;; objects, and not just plain lambda's.(let((result(iffrom-kbd(`(lambda(&restargs)(interactive)(let((qkey(intern(symbol-name(quote(,key)))efs-key-obarray))(tmp1(intern"tmp1"efs-key-obarray))(tmp2(intern"tmp2"efs-key-obarray)));; Need to store the a-f-function, to see if it has been;; re-defined by the load. This is avoid to an infinite loop.(settmp1(get(quote(,fun))qkey));; Need to store the prefix arg in case it's interactive.;; These values are stored in variables interned in the;; efs-key-obarray, because who knows what loading a;; file might do.(settmp2current-prefix-arg)(load(,file));; check for re-def(if(equal(symbol-valuetmp1)(get(quote(,fun))qkey))(error"%s definition of %s is not defined by loading %s"qkey(quote(,fun))(,file)));; call function(if(interactive-p)(let((prefix-arg(symbol-valuetmp2)))(call-interactively(get(quote(,fun))qkey)))(apply(get(quote(,fun))qkey)args)))))(`(lambda(&restargs)(let((qkey(intern(symbol-name(quote(,key)))efs-key-obarray))(tmp1(intern"tmp1"efs-key-obarray)));; Need to store the a-f-function, to see if it has been;; re-defined by the load. This is avoid to an infinite loop.(settmp1(get(quote(,fun))qkey))(load(,file));; check for re-def(if(equal(symbol-valuetmp1)(get(quote(,fun))qkey))(error"%s definition of %s is not defined by loading %s"qkey(quote(,fun))(,file)));; call function(apply(get(quote(,fun))qkey)args)))))))(list'put(list'quotefun)(list'intern(list'symbol-name(list'quotekey))'efs-key-obarray)(list'functionresult))));;; User level macros -- efs-defun and efs-autoload.(defmacroefs-defun(funamekeyargs&restbody)(let*((use(and(eq(car-safekey)'&use)(nth1key)))(key(and(nulluse)key))resultdoc-stringinteractive-p);; check args(efs-defun-arg-checkfunamekeyargs);; extract doc-string(if(stringp(carbody))(setqdoc-string(carbody)body(cdrbody)));; If the default fun is interactive, and it's a use construct,;; then we allow the gen fun to be interactive.(ifuse(setqinteractive-p(eq(car-safe(car-safebody))'interactive)))(setqresult(`((put(quote(,funame))(intern(symbol-name(quote(,key)))efs-key-obarray)(function(,(cons'lambda(consargsbody)))))(quote(,funame)))));; if the key is null, make a generic def(if(nullkey)(setqresult(cons(efs-def-genericfunameusedoc-stringinteractive-p)result)));; return(cons'prognresult)));;; For lisp-mode(put'efs-defun'lisp-indent-hook'defun);; efs-autoload;; Allows efs function cells to be defined as autoloads.;; If efs-autoload inserted autoload objects in the property list,;; and the funcall mechanism in efs-defun checked for such;; auto-load objects, we could reduce the size of the code;; resulting from expanding efs-autoload. However, the expansion;; of efs-defun would be larger. What is the best thing to do?(defmacroefs-autoload(funkeyfile&optionaldocstringfrom-kbd)(let*((use(and(eq(car-safekey)'&use)(nth1key)))(key(and(nulluse)key)))(efs-defun-arg-check(evalfun)key'autoload);; has the function been previously defined?(`(if(null(get(,fun)(intern(symbol-name(quote(,key)))efs-key-obarray)))(,(if(nullkey)(list'progn;; need to eval fun, since autoload wants an explicit;; quote built into the fun arg.(efs-def-generic(evalfun)usedocstringfrom-kbd)(efs-def-autoload(evalfun)keyfilefrom-kbd)(list'quote(list'efs-autoloadkeyfiledocstringfrom-kbd)))(list'progn(efs-def-autoload(evalfun)keyfilefrom-kbd)(list'quote(list'efs-autoloadkeyfiledocstringfrom-kbd)))))))))(defunefs-fset(symkeyfun);; Like fset but sets KEY's definition of SYM.(putsym(intern(symbol-namekey)efs-key-obarray)fun))(defunefs-fboundp(keyfun);; Like fboundp, but checks for KEY's def.(null(null(getfun(intern(symbol-namekey)efs-key-obarray)))));; If we are going to use autoload objects, the following two functions;; will be useful.;;;; (defun efs-defun-do-autoload (fun file key interactive-p args);; ;; Loads FILE and runs the KEY def of FUN.;; (let (fun file key interactive-p args);; (load file));; (let ((new-def (get fun key)));; (if (eq (car-safe new-def) 'autoload);; (error "%s definition of %s is not defined by loading %s";; key fun file);; (if interactive-p;; (let ((prefix-arg current-predix-arg));; (call-interactively fun));; (apply new-def args)))));; ;; (defun efs-defun-autoload (fun key file doc-string from-kbd);; ;; Sets the KEY def of FUN to an autoload object.;; (let* ((key (intern (symbol-name key) efs-key-obarray));; (def (get fun key)));; (if (or (null def);; (eq (car-safe def) 'autoload));; (put fun key (list 'autoload file doc-string from-kbd)))));;; end of efs-defun.el