;ELC ;;; compiled by jwz@thalidomide on Thu Feb 3 20:08:52 1994 ;;; from file /th/jwz/emacs19/lisp/utils/cl-macs.el ;;; emacs version 19.10 Lucid (beta1). ;;; bytecomp version 2.22; 22-dec-93. ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "This file was compiled for Emacs 19.")) (byte-code " >!MMM###!M!\" C@!!M" [cl-19 features error "Tried to load `cl-macs' before `cl'!" cl-push (macro . #[(x place) " EE" [setq place cons x] 5]) cl-pop (macro . #[(place) "\n\n\nDEED" [car prog1 place setq cdr] 7]) cl-pop2 (macro . #[(place) " DD ‰ DDEE" [prog1 car cdr place setq] 7]) put edebug-form-spec edebug-sexps require fboundp defalias fset cl-transform-function-property #[(n p f) "\nD DBDF" [put quote n p function lambda f] 6] cl-kludge boundp cl-old-bc-file-form nil cl-compile-time-init #[nil "K!\"#!" [byte-compile-file-form cl-old-bc-file-form fboundp byte-compile-flush-pending defalias #[(form) " \n\"= A\"B !" [macroexpand form byte-compile-macro-environment progn mapcar byte-compile-file-form cl-old-bc-file-form] 5] put eql byte-compile cl-byte-compile-compiler-macro run-hooks cl-hack-bytecomp-hook] 4]] 4) (fset 'gensym #[(&optional arg) ";\nT #!*" [arg "G" *gensym-counter* num prefix make-symbol format "%s%d"] 5 "\ Generate a new uninterned symbol. The name is made by appending a number to PREFIX, default \"G\"."]) (fset 'gentemp #[(&optional arg) "; #!Tm !*" [arg "G" nil name prefix intern-soft format "%s%d" *gensym-counter* intern] 5 "\ Generate a new interned symbol with a unique name. The name is made by appending a number to PREFIX, default \"G\"."]) (fset 'defun* '(macro . #[(name args &rest body) " \nB \" A# @ @E*" [cl-transform-lambda args body name res list* defun form progn] 4 "\ (defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. Like normal `defun', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...)."])) (fset 'defmacro* '(macro . #[(name args &rest body) " \nB \" A# @ @E*" [cl-transform-lambda args body name res list* defmacro form progn] 4 "\ (defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...)."])) (fset 'function* '(macro . #[(func) "=A\" ABD @ @E*D" [func lambda cl-transform-lambda cl-none res function form progn] 3 "\ (function* SYMBOL-OR-LAMBDA): introduce a function. Like normal `function', except that if argument is a lambda form, its ARGLIST allows full Common Lisp conventions."])) (byte-code "M!MMMM!Ƈ" [cl-transform-function-property #[(func prop form) " \n\" @AA\nDD ABDFC#)" [cl-transform-lambda form func res append (progn) put quote prop function lambda] 9] (&optional &rest &key &allow-other-keys &aux &whole &body &environment) lambda-list-keywords boundp cl-macro-environment nil cl-transform-lambda #[(form bind-block) "@A \n\n@;\n@=\nA@ B h < ! D !AAD) >! \"\" ! > \" >! >!@ \"\"DD* @9 @> @= !: A@\nB\nW=\n#C \n \n#\n> B \nG\n>⪁Z##\nA@@D D\nC#. " [form args body nil bind-defs bind-enquote bind-inits bind-lets bind-forms header simple-args interactive copy-list &rest last p cadr &cl-defs delq &cl-quote &whole error "&whole not currently implemented" &environment v &aux cl-macro-environment (nil &rest &body &key &aux) &optional bind-block cl-none list* block cl-do-arglist 1 0 eval-when (compile load eval) let*] 7] cl-do-arglist #[(args expr &optional num) "< >9\" D B!!AAD)>ɠ)>!> Љ!=DAe@>D\"GE=?)@ >A㪁D%A@U%%+=?+DDEEF\")T+@=A@p@ >jA@0:0C00!08E\"0A0A@4@0@4A@D%565D50@5%5F%\"T+\n@=A@AA0:0\")@=U+=?+DDEEEE:B:@=\"A@\"n@ >hA@0:0C00@:0!0@\"!?0@:@0!0@A0A0!4@A4!5B?DEC565D50!08 DDDDEDC\"ADFEGDEE5F\"*A5CHCI5!=ЁJ5!DD5EEDD\"?BK?!HLU?LG??DEMBM-@N=A@UہO!PQRSPTBPDUR\"DEGPމPDDEDށBRBEDDGPEDV\"PDEDFEWXPDCWE:B:+@Y=A@n@ >h@:6@!!A@!D\"V!A@!\"GA@\"<Z\"." [args lambda-list-keywords error "Invalid argument name: %s" expr bind-lets copy-list last p &rest &body &environment "&environment used incorrectly" cl-compiling-file cl-optimize-safety 3 nil minarg exactarg laterarg keys safety restarg save-args num 0 cadr gensym "--rest--" &whole cdr (nil &aux) = length ldiff pop car poparg cl-do-arglist if signal 'wrong-number-of-arguments list bind-block cl-none quote t &optional arg cddr 2 and bind-defs def bind-enquote &key 'wrong-number-of-arguments + bind-forms caar intern format ":%s" karg cadar varg memq look temp val prog1 setq or cl-const-expr-p cl-const-expr-val symbol-name 58 bind-inits &allow-other-keys "--keys--" var (:allow-other-keys) allow while cond append "Keyword argument %%s not one of %s" check let &aux "Malformed argument list %s"] 12] cl-arglist-args #[(args) "<C:A@ >\nm\n=Aa\n: \n@\n:\nA =\n! \n!> C+" [args nil arg kind res lambda-list-keywords &cl-defs &key cadr cl-arglist-args] 4] destructuring-bind (macro . #[(args expr &rest body) "\n\" D\nC#-" [nil bind-lets bind-forms bind-inits bind-defs cl-none bind-block cl-do-arglist args (&aux) expr append (progn) let* body] 5]) cl-not-toplevel] 2) (fset 'eval-when '(macro . #[(when &rest body) "! \n!>> >> \"B҉$ B!*>>B" [fboundp cl-compiling-file cl-not-toplevel boundp for-effect compile when :compile-toplevel t comp load :load-toplevel progn mapcar cl-compile-time-too body list* if nil eval :execute] 5 "\ (eval-when (WHEN...) BODY...): control when BODY is evaluated. If `compile' is in WHEN, BODY is evaluated when compiled at top-level. If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level."])) (byte-code "M!K=!" [cl-compile-time-too #[(form) "9N B\"=A\"B=A@  > > B!#)!" [form byte-hunk-handler macroexpand (eval-when) byte-compile-macro-environment progn mapcar cl-compile-time-too eval-when when eval :execute list* compile cddr] 5] fboundp eval-when-compile autoload eval (defmacro eval-when-compile (&rest body) "Like `progn', but evaluates the body at compile time.\nThe result of the body appears to the compiler as a quoted constant." (list 'quote (eval (cons 'progn body))))] 2) (fset 'load-time-value '(macro . #[(form &optional read-only) " ! DE!!!KDE DDѯM J\" *DD!D" [cl-compiling-file gentemp "--cl-load-time--" temp set quote form fboundp byte-compile-file-form-defmumble boundp this-kind that-one byte-compile-file-form lambda (form) fset 'byte-compile-file-form (byte-compile-file-form form) print byte-compile-output-buffer symbol-value eval] 7 "\ Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant."])) (fset 'case '(macro . #[(expr &rest clauses) " \" \n\"B = DC E+" [cl-simple-expr-p expr 3 gensym temp nil head-list cond mapcar #[(c) "@>ª@= !DF@<@ \" @DE@ >@\"@ B @DEAB" [c (t otherwise) t ecase-error-flag error "ecase failed: %s, %s" temp quote reverse head-list append member* "Duplicate key in case: %s" eql (nil)] 6] clauses body let] 4 "\ (case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared against each key in each KEYLIST; the corresponding BODY is evaluated. If no clause succeeds, case returns nil. A single atom may be used in place of a KEYLIST of one atom. A KEYLIST of `t' or `otherwise' is allowed only in the final clause, and matches if no other keys match. Key values are compared by `eql'."])) (fset 'ecase '(macro . #[(expr &rest clauses) "\n \"#" [list* case expr append clauses ((ecase-error-flag))] 6 "\ (ecase EXPR CLAUSES...): like `case', but error if no case fits. `otherwise'-clauses are not allowed."])) (fset 'typecase '(macro . #[(expr &rest clauses) " \" \n\"B = DC E+" [cl-simple-expr-p expr 3 gensym temp nil type-list cond mapcar #[(c) "@=ª@= !DF@ B @\"AB" [c otherwise t ecase-error-flag error "etypecase failed: %s, %s" temp quote reverse type-list cl-make-type-test (nil)] 6] clauses body let] 4 "\ (typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the final clause, and matches if no other keys match."])) (fset 'etypecase '(macro . #[(expr &rest clauses) "\n \"#" [list* typecase expr append clauses ((ecase-error-flag))] 6 "\ (etypecase EXPR CLAUSES...): like `typecase', but error if no case fits. `otherwise'-clauses are not allowed."])) (fset 'block '(macro . #[(name &rest body) "\nB!\nB\n\"!D\n#D" [cl-safe-expr-p progn body cl-block-wrapper list* catch quote intern format "--cl-block-%s--" name] 8 "\ (block NAME BODY...): define a lexically-scoped block named NAME. NAME may be any symbol. Code inside the BODY forms can call `return-from' to jump prematurely out of the block. This differs from `catch' and `throw' in two respects: First, the NAME is an unevaluated symbol rather than a quoted symbol or other form; and second, NAME is lexically rather than dynamically scoped: Only references to it within BODY will work. These references may appear inside macro expansions, but not inside functions called from BODY."])) (byte-code "!#M#M" [boundp cl-active-block-names nil put cl-block-wrapper byte-compile cl-byte-compile-block #[(cl-form) "!\nA@A@A@B B\nA@!B! A\nA@A@ E! !+\nA@!" [fboundp byte-compile-form-do-effect cl-form nil cl-entry cl-active-block-names byte-compile-top-level progn cddr cl-body byte-compile-form catch] 5] cl-block-throw cl-byte-compile-throw #[(cl-form) "A@A@ \ná)AB!" [cl-form cl-active-block-names cl-found t byte-compile-normal-call throw] 4]] 4) (fset 'return '(macro . #[(&optional res) "\nE" [return-from nil res] 3 "\ (return [RESULT]): return from the block named nil. This is equivalent to `(return-from nil RESULT)'."])) (fset 'return-from '(macro . #[(name &optional res) " \"! DE)" [intern format "--cl-block-%s--" name name2 cl-block-throw quote res] 4 "\ (return-from NAME [RESULT]): return from the block named NAME. This jump out to the innermost enclosing `(block NAME ...)' form, returning RESULT from that form (or nil if RESULT is omitted). This is compatible with Common Lisp, but note that `defun' and `defmacro' do not create implicit blocks as they do in Common Lisp."])) (fset 'loop '(macro . #[(&rest args) "!\"\"\">#Eĉ\n   \"@= tDCB  DCB EBC!!!!# !@=#!@E#B #E!@##C隫CBFC#,CB!A@,#C,e/!A@@/B/g/,#C,)<\n\n,#C,,#." [t mapcar symbolp delq nil copy-list args block list* while loop-symbol-macs loop-destr-temps loop-first-flag loop-map-form loop-finally loop-initially loop-accum-vars loop-accum-var loop-finish-flag loop-result-var loop-result-explicit loop-result loop-steps loop-body loop-bindings loop-name append (cl-end-loop) cl-end-loop cl-parse-loop-clause setq epilogue cl-loop-build-ands ands cadr while-body --cl-finish-- subst or (return-from --cl-finish-- nil) --cl-map (nil) if progn body cdar cl-loop-let lets symbol-macrolet] 16 "\ (loop CLAUSE...): The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND, always COND, never COND, thereis COND, collect EXPR into VAR, append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR, count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR, if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR, finally return EXPR, named NAME."])) (byte-code "MMMM" [cl-parse-loop-clause #[nil "A@! =A@  =@>A@:!@: A@ B n =@=A@AA @>A@:!!= A@A@ @: A@Bn >؉A@ A@=A@ >A@ >B > B@>!@=!>*@>!>-@>A@AA/@>A@AA1@=A@AA31!? 53!? 6333X3\"/DB551DB663DB1*--51E=B=*63@EDB. A> B=B9 CA@DBDCD=B= E=FCDDGBGC=DBBCFCDDBC@=A@AA3H>3A@93A@CDI3CE)JCDDB* K=A@/@L=A@AA/LDB@M=NO O/FDBLDB/L=/NO O/LFDB* P> QRA@DBQSDBTQUQDEVRDE=B= W=XRQEDGBGDBXRQEDB* Y>@Z>@[>?Ɓ\\!A@AA @]=^!G_U`!a=^A@AA!Ɓb! QcdecdDBQDBe fVcDDBgcQEDGBGQfE=B=)DBMchDcDQVcDEEE=B=NDcDicDXcQEFDBQUQDDB, > @j>Ɓ\\!A@AAk@]=^!G_U`! >`! =^A@AA!Ɓb! l m>llnopqlDr#DkEs* t>@u>A@AAvwopqCr#DvEs) x>؉yz{@|>@z=A@AAze@y=A@AAyRA@AA{G}oq D~FD{zys+ >y؉ yz{@>@z=A@AAze@y=A@AAyR@=A@AA?A@AA{4:@9A9@AEDBoqDED{zys. >@>Ɓ\\!A@AA@]=^!G_U`! >`! =^A@AA!Ɓb! l >ll >opqlDr#DEs* > C=DBCDBCEDhCTCEEE=B==DDB) >@>A@AA C=DDBCDBCEDhCTCEEE=B=DDB* 9 N!Ɓ \")@)M=AB\"T#E=B=T\"BB, = CA@DCBTCCDEE=B=) =A@؁\"=EE=B=TDEEE=B=* >A@؁\"T= >DE >EEE=B=* >A@!FE=B=* >A@!FE=B=* >A@!EE=B=* >A@!NDEE=B=* >A@! C! !O!ȁTNCECFEɁC=ɪCDCEE=B=- =A@@K=A@AADB@M=AW̟B) =A@=B= =A@D=B= =Ь ЁTA@E=B=т =Ь ЁTЁA@DE=B=т =Ь Ԭ ԁTЁTA@EDE=B= > A@= =!)L=@=A =!)L@=@=@=A =LLګLA@B_L8ګA@_8CB܁܁\" CCBpNTCEC##)pN#ګ܁E=B=- >@:Ɓ!@:A@BoBB=B=) =Ь Ԭ ԁTA@د=B= 9 NƁ \" )@M=A +" [args (hash-key hash-keys hash-value hash-values) (key-code key-codes key-seq key-seqs key-binding key-bindings) key-types hash-types word error "Malformed `loop' macro" named loop-name initially (do doing) "Syntax error on `initially' clause" loop-initially finally return 'nil loop-result-explicit (do doing) "Syntax error on `finally' clause" caar 'nil loop-finally (for as) nil ands loop-for-steps loop-for-sets loop-for-bindings gensym var being (the each) (buffer buffers) in (buffer-list) (from downfrom upfrom to downto upto above below by) (downto above) "Must specify `from' value for downward loop" downfrom caddr (downto above) down (above below) (above below) excl (from upfrom downfrom) start (to upto downto above below) end by step cl-const-expr-p end-var step-var 0 "Loop `by' value is not positive: %s" > >= < <= loop-body - + 1 (in in-ref on) on temp consp in-ref car loop-symbol-macs (quote function function*) funcall cdr = then and if loop-first-flag (across across-ref) temp-idx temp-vec -1 setq 1+ length across-ref aref (element elements) (in-ref of-ref) (in of) "Expected `of'" using cadr 2 caadr index "Bad `using' clause" temp-seq seq ref temp-len elt or pop (in of) table other (hash-value hash-values) maphash function list* lambda --cl-map loop-map-form (symbol present-symbol external-symbol symbols present-symbols external-symbols) (in of) ob mapatoms (overlay overlays extent extents) to from buf (in of from to) cl-map-extents (progn . --cl-map) (interval intervals) var2 var1 prop (in of property from to) property cons cl-map-intervals (progn . --cl-map) (in of) map (key-binding key-bindings) (key-seq key-seqs) cl-map-keymap-recursively cl-map-keymap (frame frames screen screens) cl-emacs-type lucid (selected-screen) (selected-frame) prog1 not eq next-screen next-frame (window windows) (in of) scr screen-selected-window frame-selected-window (selected-window) next-window cl-loop-for-handler handler "Expected a `for' preposition, found %s" t loop-bindings mapcar list progn cl-loop-let psetq apply append loop-steps repeat 1- collect cl-loop-handle-accum nreverse what loop-accum-var push nconc (nconc nconcing append appending) (nconc nconcing) reverse (nconc nconcing) (concat concating) "" callf concat (vconcat vconcating) [] vconcat (sum summing) incf (count counting) (minimize minimizing maximize maximizing) cl-simple-expr-p intern symbol-name 3 func set let with bindings while until always loop-finish-flag loop-result never thereis loop-result-var (if when unless) cond cl-parse-loop-clause cl-loop-build-ands else simple unless form cl-expr-contains it subst (do doing) body "Syntax error on `do' clause" cl-loop-handler "Expected a loop keyword, found %s"] 9] cl-loop-let #[(specs body par) " @9 ! Ao  !!  !D B ! ) A_@:!<!  A@!   \" BB@A D\nB : A @ Ӫ DD B ] ,A@\nB=ת\n\"B E)ݪ \n#+" [specs nil new temps p cadar par cl-const-expr-p gensym temp cdar caar spec nspecs cadr expr loop-destr-temps last 0 pop car body setq psetq apply nconc set let* list* let] 5] cl-loop-handle-accum #[(def &optional func) "@=A@AA >\n DC B\n B\n)  DC BD " [args into var loop-accum-vars def loop-bindings loop-accum-var gensym func loop-result] 3] cl-loop-build-ands #[(clauses) " @= @!@= A @! != ! !C !BL A@!A@ A@\nB6\nCA\nB\n@ \n \"BC\"\nAB@)E*" [nil body ands clauses progn last t butlast cadr cdadr cddr and append (t) full] 9]] 2) (fset 'do '(macro . #[(steps endtest &rest body) " \n $" [cl-expand-do-loop steps endtest body nil] 5 "\ The Common Lisp `do' loop. Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"])) (fset 'do* '(macro . #[(steps endtest &rest body) " \n $" [cl-expand-do-loop steps endtest body t] 5 "\ The Common Lisp `do*' loop. Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"])) (fset 'cl-expand-do-loop #[(steps endtest body star) " Ī\" @D \"\" AѪ\"BC)\"# A$E" [block nil list* star let* let mapcar #[(c) ":@A@D" [c] 2] steps while not endtest append body #[(c) ":AA@8D" [c 2] 3] sets delq setq psetq apply (nil)] 15]) (fset 'dolist '(macro . #[(spec &rest body) "!\nA@D@D\n@\nDE \n\nDEC\"$AA@EAAB$E)" [gensym "--dolist-temp--" temp block nil list* let spec while setq car append body cdr (nil)] 15 "\ (dolist (VAR LIST [RESULT]) BODY...): loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil."])) (fset 'dotimes '(macro . #[(spec &rest body) "!\nA@D@DD@\nE @DC\"#AA$E)" [gensym "--dotimes-temp--" temp block nil list* let spec 0 while < append body incf (nil)] 12 "\ (dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get return value, default nil."])) (fset 'do-symbols '(macro . #[(spec &rest body) " @C @C#D ! !C# !FE" [block nil let spec list* mapatoms function lambda body cadr caddr] 11 "\ (dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol from OBARRAY."])) (fset 'do-all-symbols '(macro . #[(spec &rest body) "\n@\n!E #" [list* do-symbols spec nil cadr body] 6])) (fset 'psetq '(macro . #[(&rest args) " B" [psetf args] 2 "\ (psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel. This is like `setq', except that all VAL forms are evaluated (in order) before assigning any symbols SYM to the corresponding values."])) (fset 'progv '(macro . #[(symbols values &rest body) "E#EE" [let ((cl-progv-save nil)) unwind-protect list* progn cl-progv-before symbols values body (cl-progv-after)] 8 "\ (progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY. The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. Each SYMBOL in the first list is bound to the corresponding VALUE in the second list (or made unbound if VALUES is shorter than SYMBOLS); then the BODY forms are executed and their result is returned. This is much like a `let' form, except that the list of symbols can be computed at run-time."])) (fset 'flet '(macro . #[(bindings &rest body) " \" #" [list* letf* mapcar #[(x) " ! @ !#ED ! @!B\nB\n @DD)D" [function* lambda cadr x list* block cddr func cl-compiling-file boundp byte-compile-function-environment eval symbol-function quote] 8] bindings body] 5 "\ (flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns. This is an analogue of `let' that operates on the function cell of FUNC rather than its value cell. The FORMs are evaluated with the specified function definitions in place, then the definitions are undone (the FUNCs go back to their previous definitions, or lack thereof)."])) (fset 'labels '(macro . #[(&rest args) " B" [flet args] 2])) (fset 'macrolet '(macro . #[(bindings &rest body) "A@CA #E B!!\"  @! B A# B\"*" [bindings macrolet list* body progn caar name cl-transform-lambda cdar res eval cl-macroexpand-all lambda cl-macro-environment] 6 "\ (macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns. This is like `flet', but for macros instead of functions."])) (fset 'symbol-macrolet '(macro . #[(bindings &rest body) "A@CA #E B B!!!D B\"" [bindings symbol-macrolet list* body progn cl-macroexpand-all symbol-name caar cadar cl-macro-environment] 6 "\ (symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns. Within the body FORMs, references to the variable NAME will be replaced by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)."])) (byte-code "!‡" [boundp cl-closure-vars nil] 2) (fset 'lexical-let '(macro . #[(bindings &rest body) " \"B \"C\n\" !@N \" \" \"E \" \"# F+" [cl-closure-vars mapcar #[(x) ":C@\"! B@! @E" [x gensym format "--%s--" cl-closure-vars cadr] 4] bindings vars cl-macroexpand-all progn body #[(x) " @! !DE" [symbol-name x symbol-value caddr t] 4] (defun . cl-defun-expander) cl-macro-environment ebody last used let #[(x) " ! !D" [caddr x cadr] 3] sublis #[(x) " ! !DB" [caddr x quote] 4] #[(x) " ! @\"DD" [caddr x make-symbol format "--%s--"] 5] apply append (setf) #[(x) "\n!D\n!D" [symbol-value caddr x cadr] 3]] 8 "\ (lexical-let BINDINGS BODY...): like `let', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp."])) (fset 'lexical-let* '(macro . #[(bindings &rest body) "\nB!A@C\n#Co\n@" [bindings progn body reverse list* lexical-let] 4 "\ (lexical-let* BINDINGS BODY...): like `let*', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp."])) (fset 'cl-defun-expander #[(func &rest rest) " DBDE DE" [progn defalias quote func function lambda rest] 6]) (fset 'multiple-value-bind '(macro . #[(vars form &rest body) "  D \"B\n#*" [gensym -1 n temp list* let* form mapcar #[(v) "\nT ED" [v nth n temp] 4] vars body] 6 "\ (multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements of this list bound (`let'-style) to each of the symbols SYM in turn. This is analogous to the Common Lisp `multiple-value-bind' macro, using lists to simulate true multiple return values. For compatibility, (values A B C) is a synonym for (list A B C)."])) (fset 'multiple-value-setq '(macro . #[(vars form) "\nEA@\nDE  \nDCA@DE\"\"BEE*" [vars progn form nil setq car gensym temp 0 n let prog1 apply nconc mapcar #[(v) "\nT ED" [v nth n temp] 4]] 10 "\ (multiple-value-setq (SYM SYM...) FORM): collect multiple return values. FORM must return a list; the first N elements of this list are stored in each of the symbols SYM in turn. This is analogous to the Common Lisp `multiple-value-setq' macro, using lists to simulate true multiple return values. For compatibility, (values A B C) is a synonym for (list A B C)."])) (byte-code "MM!!M !   A @\"o )M" [locally (macro . #[(&rest body) " B" [progn body] 2]) the (macro lambda (type form) form) boundp cl-proclaim-history t cl-declare-stack cl-do-proclaim #[(spec hist) " <\n B\n=!\nA \"\n=\nA\n@N>\n@\"\n@#b\n=\nA\n@N=q\n@#h\n=\nAA@Ҟ\nAA@Ԟ@A@@A@*\n=!=\nA\n@:u\n!=\n!\"c\n!\"Xχ" [hist cl-proclaim-history spec special boundp byte-compile-bound-variables append inline byte-optimizer (nil byte-compile-inline-expand) error "%s already has a byte-optimizer, can't make it inline" put byte-compile-inline-expand notinline nil optimize speed ((0 nil) (1 t) (2 t) (3 t)) safety ((0 t) (1 t) (2 t) (3 nil)) cl-optimize-speed byte-optimize cl-optimize-safety byte-compile-delete-errors warn byte-compile-warnings t byte-compile-default-warnings cadar 0 delq caar adjoin] 5] reverse cl-proclaims-deferred p nil declare (macro . #[(&rest specs) " \n< @\nB A@\"ić" [cl-compiling-file specs cl-declare-stack cl-do-proclaim nil] 3])] 3) (fset 'define-setf-method '(macro . #[(func args &rest body) "\n@; D\nA@FC  \nB#C#" [append (eval-when (compile load eval)) body put quote func 'setf-documentation cl-transform-function-property setf-method args] 8 "\ (define-setf-method NAME ARGLIST BODY...): define a `setf' method. This method shows how to handle `setf's to places of the form (NAME ARGS...). The argument forms ARGS are bound according to ARGLIST, as if NAME were going to be expanded as a macro, then the BODY forms are executed and must return a list of five elements: a temporary-variables list, a value-forms list, a store-variables list (of length one), a store-form, and an access- form. See `defsetf' for a simpler way to define most setf-methods."])) (fset 'defsetf '(macro . #[(func arg1 &rest args) "@:@@@\nB\n@\"! BA<\n \nC\"\"! C\"\n \n @@\"DDB@@DBAAS*DBEC  \"DDEDC\"Bઁ Bઁ B D  DBBBઁD BBEC#. DE'@'F')" [arg1 nil largs largsr temps tempsr restarg rest-temps args store-var intern format "--%s--temp--" store-temp lets1 lets2 docstr p &aux &rest (&optional &key &allow-other-keys) append p2 p1 gensym "--%s--" define-setf-method func let* mapcar 'gensym list list* quote defsetf (&rest args) (store) cons (append args (list store)) call 'progn store] 14 "\ (defsetf NAME FUNC): define a `setf' method. This macro is an easy-to-use substitute for `define-setf-method' that works well for simple place forms. In the simple `defsetf' form, `setf's of the form (setf (NAME ARGS...) VAL) are transformed to function or macro calls of the form (FUNC ARGS... VAL). Example: (defsetf aref aset). Alternate form: (defsetf NAME ARGLIST (STORE) BODY...). Here, the above `setf' call is expanded by binding the argument forms ARGS according to ARGLIST, binding the value form VAL to STORE, then executing BODY, which must return a Lisp form that does the necessary `setf' operation. Actually, ARGLIST and STORE may be bound to temporary variables which are introduced automatically to preserve proper execution order of the arguments. Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))."])) (byte-code "###############################@A#BC#DE#FG#HI#JK#LM#NO#PQ#RS#TU#VW#XY#Z[#\\]#^_#`a#bc#de#fg#hi#jk#lm#no#pq#rs#tu#vw#xy#z{#|}#~##################################" [put aref setf-method #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store aset append aref] 7] car #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store setcar append car] 7] cdr #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store setcdr append cdr] 7] elt #[(seq n) "!!!\n DDC\n  DE E FF+\n E+" [gensym "--seq--" --seq--temp-- "--n--" --n--temp-- "--store--" --store--temp-- seq n store if listp setcar nthcdr aset elt] 10] get #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store put append get] 7] get* #[(x y &optional d) "!!!!\n E \n EC\n \n   \n F,\n F," [gensym "--x--" --x--temp-- "--y--" --y--temp-- "--d--" --d--temp-- "--store--" --store--temp-- x y d store put get*] 8] gethash #[(x h &optional d) "!!!!\n E \n EC\n \n    \nF,\n F," [gensym "--x--" --x--temp-- "--h--" --h--temp-- "--d--" --d--temp-- "--store--" --store--temp-- x h d store cl-puthash gethash] 8] nth #[(n x) "!!!\n DDC\n  E E+\n E+" [gensym "--n--" --n--temp-- "--x--" --x--temp-- "--store--" --store--temp-- n x store setcar nthcdr nth] 7] subseq #[(seq start &optional end) "!!!!\n E \n EC\n \n    \n  E,\n F," [gensym "--seq--" --seq--temp-- "--start--" --start--temp-- "--end--" --end--temp-- "--new--" --new--temp-- seq start end new progn replace :start1 :end1 subseq] 11] symbol-function #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store fset append symbol-function] 7] symbol-plist #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store setplist append symbol-plist] 7] symbol-value #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set append symbol-value] 7] first #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store setcar append first] 7] second #[(x) "!!\nC C C\n  DE*\nD*" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar cdr second] 6] third #[(x) "!!\nC C C\n  DE*\nD*" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar cddr third] 6] fourth #[(x) "!!\nC C C\n  DE*\nD*" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar cdddr fourth] 6] fifth #[(x) "!!\nC C C\n  EE*\nD*" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 4 fifth] 7] sixth #[(x) "!!\nC C C\n  EE*\nD*" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 5 sixth] 7] seventh #[(x) "!!\nC C C\n  EE*\nD*" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 6 seventh] 7] eighth #[(x) "!!\nC C C\n  EE*\nD*" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 7 eighth] 7] ninth #[(x) "!!\nC C C\n  EE*\nD*" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 8 ninth] 7] tenth #[(x) "!!\nC C C\n  EE*\nD*" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 9 tenth] 7] rest #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store setcdr append rest] 7] buffer-file-name #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-visited-file-name append buffer-file-name] 8] buffer-modified-p #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-buffer-modified-p append buffer-modified-p] 8] buffer-name #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn rename-buffer append buffer-name] 8] buffer-string #[nil "!É\nC\n DE)C)" [gensym "--store--" --store--temp-- nil store progn (erase-buffer) insert buffer-string] 7] buffer-substring #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store cl-set-buffer-substring append buffer-substring] 7] current-buffer #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-buffer append current-buffer] 7] current-case-table #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-case-table append current-case-table] 7] current-column #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn move-to-column append current-column] 8] current-global-map #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn use-global-map append current-global-map] 8] current-input-mode #[nil "!É\nC\n E E)C)" [gensym "--store--" --store--temp-- nil store progn apply set-input-mode current-input-mode] 7] current-local-map #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn use-local-map append current-local-map] 8] current-window-configuration #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-window-configuration append current-window-configuration] 8] default-file-modes #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-default-file-modes append default-file-modes] 8] default-value #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-default append default-value] 7] documentation-property #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store put append documentation-property] 7] extent-data #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-extent-data append extent-data] 7] extent-face #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-extent-face append extent-face] 7] extent-priority #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-extent-priority append extent-priority] 7] extent-property #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-extent-property append extent-property] 7] extent-end-position #[(ext) "!!\nC C C\n  DEE*\nD*" [gensym "--ext--" --ext--temp-- "--store--" --store--temp-- ext store progn set-extent-endpoints extent-start-position extent-end-position] 7] extent-start-position #[(ext) "!!\nC C C\n  DEE*\nD*" [gensym "--ext--" --ext--temp-- "--store--" --store--temp-- ext store progn set-extent-endpoints extent-end-position extent-start-position] 8] face-background #[(f &optional s) "!!!\n DDC\n   F+\n E+" [gensym "--f--" --f--temp-- "--s--" --s--temp-- "--x--" --x--temp-- f s x set-face-background face-background] 7] face-background-pixmap #[(f &optional s) "!!!\n DDC\n   F+\n E+" [gensym "--f--" --f--temp-- "--s--" --s--temp-- "--x--" --x--temp-- f s x set-face-background-pixmap face-background-pixmap] 7] face-font #[(f &optional s) "!!!\n DDC\n   F+\n E+" [gensym "--f--" --f--temp-- "--s--" --s--temp-- "--x--" --x--temp-- f s x set-face-font face-font] 7] face-foreground #[(f &optional s) "!!!\n DDC\n   F+\n E+" [gensym "--f--" --f--temp-- "--s--" --s--temp-- "--x--" --x--temp-- f s x set-face-foreground face-foreground] 7] face-underline-p #[(f &optional s) "!!!\n DDC\n   F+\n E+" [gensym "--f--" --f--temp-- "--s--" --s--temp-- "--x--" --x--temp-- f s x set-face-underline-p face-underline-p] 7] file-modes #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-file-modes append file-modes] 8] frame-height #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-screen-height append frame-height] 8] frame-parameters #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn modify-frame-parameters append frame-parameters] 8] frame-visible-p #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store cl-set-frame-visible-p append frame-visible-p] 7] frame-width #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-screen-width append frame-width] 8] getenv #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn setenv append getenv] 8] get-register #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-register append get-register] 7] global-key-binding #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store global-set-key append global-key-binding] 7] keymap-parent #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-keymap-parent append keymap-parent] 7] local-key-binding #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store local-set-key append local-key-binding] 7] mark #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-mark append mark] 8] mark-marker #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-mark append mark-marker] 8] marker-position #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-marker append marker-position] 8] match-data #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn store-match-data append match-data] 8] mouse-position #[(scr) "!!\nC C C\n  DDD*\nD*" [gensym "--scr--" --scr--temp-- "--store--" --store--temp-- scr store set-mouse-position car cadr cddr mouse-position] 9] overlay-get #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store overlay-put append overlay-get] 7] overlay-start #[(ov) "!!\nC C C\n   DFE*\nD*" [gensym "--ov--" --ov--temp-- "--store--" --store--temp-- ov store progn move-overlay overlay-end overlay-start] 9] overlay-end #[(ov) "!!\nC C C\n  DFE*\nD*" [gensym "--ov--" --ov--temp-- "--store--" --store--temp-- ov store progn move-overlay overlay-start overlay-end] 8] point #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store goto-char append point] 7] point-marker #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn goto-char append point-marker] 8] point-max #[nil "!É\nC\n E E)C)" [gensym "--store--" --store--temp-- nil store progn narrow-to-region (point-min) point-max] 7] point-min #[nil "!É\nC\n E E)C)" [gensym "--store--" --store--temp-- nil store progn narrow-to-region (point-max) point-min] 7] process-buffer #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-process-buffer append process-buffer] 7] process-filter #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-process-filter append process-filter] 7] process-sentinel #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-process-sentinel append process-sentinel] 7] read-mouse-position #[(scr) "!!\nC C C\n  DDF*\nD*" [gensym "--scr--" --scr--temp-- "--store--" --store--temp-- scr store set-mouse-position car cdr read-mouse-position] 8] screen-height #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-screen-height append screen-height] 8] screen-width #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-screen-width append screen-width] 8] selected-window #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store select-window append selected-window] 7] selected-screen #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store select-screen append selected-screen] 7] selected-frame #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store select-frame append selected-frame] 7] standard-case-table #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-standard-case-table append standard-case-table] 7] syntax-table #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-syntax-table append syntax-table] 7] visited-file-modtime #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-visited-file-modtime append visited-file-modtime] 8] window-buffer #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-window-buffer append window-buffer] 8] window-display-table #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-window-display-table append window-display-table] 8] window-dedicated-p #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-window-dedicated-p append window-dedicated-p] 8] window-height #[nil "!É\nC\n ED E)C)" [gensym "--store--" --store--temp-- nil store progn enlarge-window - (window-height) window-height] 8] window-hscroll #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-window-hscroll append window-hscroll] 7] window-point #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-window-point append window-point] 7] window-start #[(&rest args) "\n\"! !\n! C  \nC\"*B \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-window-start append window-start] 7] window-width #[nil "!É\nC\n EE E)C)" [gensym "--store--" --store--temp-- nil store progn enlarge-window - (window-width) t window-width] 8] x-get-cutbuffer #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn x-store-cutbuffer append x-get-cutbuffer] 8] x-get-cut-buffer #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn x-store-cut-buffer append x-get-cut-buffer] 8] x-get-secondary-selection #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn x-own-secondary-selection append x-get-secondary-selection] 8] x-get-selection #[(&rest args) "\n\"! !\n! C  \nC\"BE* \"*" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn x-own-selection append x-get-selection] 8] apply #[(func arg1 &rest rest) ">9\"A@ BB\" @ A@ 8 8! @# 8! @#*" [func (quote function function*) error "First arg to apply in setf is not (function SYM): %s" arg1 rest form get-setf-method cl-macro-environment method 2 cl-setf-make-apply 3 cadr 4] 9]] 4) (byte-code "M###" [cl-setf-make-apply #[(form func temps) "@=! #!#!! \"@DA#" [form progn list* cl-setf-make-apply cadr func temps cddr last error "%s is not suitable for use with setf-of-apply" apply quote] 6] put nthcdr setf-method #[(n place) " \n\"!!@B A@BC8@8FDC8F8E+" [get-setf-method place cl-macro-environment gensym "--nthcdr-n--" "--nthcdr-store--" store-temp n-temp method n let 2 cl-set-nthcdr 4 3 nthcdr] 9] getf #[(place tag &optional def) " \n\"!!! \n\n@ D\"\nA@  D\"C\n8@\n8 FDC\n8F\n8 F," [get-setf-method place cl-macro-environment gensym "--getf-tag--" "--getf-def--" "--getf-store--" store-temp def-temp tag-temp method append tag def let 2 cl-set-getf 4 3 getf] 9] substring #[(place from &optional to) " \n\"!!! \n\n@ D\"\nA@  D\"C\n8@\n8 DC\n8F\n8 F," [get-setf-method place cl-macro-environment gensym "--substring-from--" "--substring-to--" "--substring-store--" store-temp to-temp from-temp method append from to let 2 cl-set-substring 4 3 substring] 10]] 4) (fset 'get-setf-method #[(place &optional env) "9!ĉ C E)@9@!N\n \n  \nA\"\n)\n:\nGU\n\"\"!!=GS8 \", \"=@9@!@K9@KAB \"@\" \"" [place gensym "--setf--" temp nil setq func symbol-name name setf-method method case-fold-search env cl-macro-environment apply 5 error "Setf-method for %s returns malformed method" string-match "\\`c[ad][ad][ad]?[ad]?r\\'" get-setf-method compiler-macroexpand edebug-after macroexpand fboundp "No setf-method known for %s"] 6 "\ Return a list of five values describing the setf-method for PLACE. PLACE may be any Lisp form which can appear as the PLACE argument to a macro like `setf' or `incf'."]) (byte-code "MMM" [cl-setf-do-modify #[(place opt-expr) " \n\"@ A@ =? = ! 8@ 8\" : A!  @! A@ A@BBa A@ A@DBO 8@ 8\"B 8\"E." [get-setf-method place cl-macro-environment method temps values nil lets subs opt-expr no-opt unsafe cl-safe-expr-p cl-setf-simple-store-p 2 3 optimize cl-simple-exprs-p simple cl-const-expr-p sublis 4] 7] cl-setf-do-store #[(spec val) "@A ! ! \n\"=\n \" \n #\n DC E*" [spec form sym cl-const-expr-p val cl-simple-expr-p cl-expr-contains 1 cl-setf-simple-store-p subst let] 4] cl-setf-simple-store-p #[(sym form) ":\n\"=GS8\n=@9@!@K=?" [form cl-expr-contains sym 1 fboundp macro] 3]] 2) (fset 'setf '(macro . #[(&rest args) "AAA@A@E\nBl\n)B@9B@A@\"A@A@\" @@ E *" [args nil sets setf progn setq cl-setf-do-modify method cl-setf-do-store store let*] 4 "\ (setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL. This is a generalized version of `setq'; the PLACEs may be symbolic references such as (car x) or (aref x i), as well as plain symbols. For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y). The return value is the last VAL in the list."])) (fset 'psetf '(macro . #[(&rest args) " @9 A@ \" @ > @\" A@ B ! AL BE!!@E!!@EEjE)+" [args t nil vars simple p cl-expr-depends-p error "Destination duplicated in psetf: %s" "Odd number of arguments to psetf" progn setf reverse cadr expr cddr prog1] 5 "\ (psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel. This is like `setf', except that all VAL forms are evaluated (in order) before assigning any PLACEs to the corresponding values."])) (fset 'cl-do-pop #[(place) " ! D DEE \"! @ 8DC\" DA@ D\"EE*" [cl-simple-expr-p place prog1 car setf cdr cl-setf-do-modify t method gensym "--pop--" temp let* append 2 cl-setf-do-store] 8]) (fset 'remf '(macro . #[(place tag) " \" !?! !?!    8 @  8DC DC# DE A@D\"E EFE-" [cl-setf-do-modify place t method cl-const-expr-p tag gensym "--remf-tag--" tag-temp cl-simple-expr-p "--remf-place--" val-temp ttag 2 tval let* append if eq car progn cl-setf-do-store cddr cl-do-remf] 9 "\ (remf PLACE TAG): remove TAG from property list PLACE. PLACE may be a symbol, or any generalized variable allowed by `setf'. The form returns true if TAG was found and removed, nil otherwise."])) (fset 'shiftf '(macro . #[(place &rest args) " B!\">  @EB A@k)# B! A @   A @\"@8A@ \"EE )X *" [nil mapcar symbolp butlast place args list* prog1 sets setq reverse places form cl-setf-do-modify unsafe method let* 2 cl-setf-do-store] 8 "\ (shiftf PLACE PLACE... VAL): shift left among PLACEs. Example: (shiftf A B C) sets A to B, B to C, and returns the old A. Each PLACE may be a symbol, or any generalized variable allowed by `setf'."])) (fset 'rotatef '(macro . #[(&rest args) " \"> A @ A A@ @DoC @ D* !!  AA@\"@8A@ \"EE )W@\"@ 8DC\"A@ \"F," [nil mapcar symbolp args first sets psetf reverse places gensym "--rotatef--" temp form cl-setf-do-modify unsafe method let* prog1 2 cl-setf-do-store append] 8 "\ (rotatef PLACE...): rotate left among PLACEs. Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. Each PLACE may be a symbol, or any generalized variable allowed by `setf'."])) (fset 'letf '(macro . #[(bindings &rest body) "A!!9 #Ɖ! \n !9!DD!!\"!@>!!?A!@@=ݪ8A@DD8EDD8DCDC  @AA@\" B BA@\"@=媁8A@DFA@\"ECA.# #," [bindings cdar caar list* let body nil reverse rev unsets sets lets symbol-value quote place cadar value cl-setf-do-modify no-opt method gensym "--letf-save--" save (symbol-value symbol-function) "--letf-bound--" bound cl-const-expr-p "--letf-val--" temp boundp fboundp 2 and unwind-protect progn cl-setf-do-store if makunbound fmakunbound let*] 8 "\ (letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY."])) (fset 'letf* '(macro . #[(bindings &rest body) "\nB!A@C\n#Co\n@" [bindings progn body reverse list* letf] 4 "\ (letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. This is the analogue of `let*', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY."])) (fset 'callf '(macro . #[(func place &rest args) " B\" 8 B @ A@ 9 B D#\"E*" [cl-setf-do-modify place list args method 2 rargs let* cl-setf-do-store func list* funcall function] 8 "\ (callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, or any generalized variable allowed by `setf'."])) (fset 'callf2 '(macro . #[(func arg1 place &rest args) " ! ! 9 $E B\"\n !?! \n8# DC\n@\"\nA@ 9 B D#\"E+" [cl-safe-expr-p arg1 cl-simple-expr-p place func setf list* args cl-setf-do-modify list method cl-const-expr-p gensym "--arg1--" temp 2 rargs let* append cl-setf-do-store funcall function] 8 "\ (callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...). Like `callf', but PLACE is the second argument of FUNC, not the first."])) (fset 'define-modify-macro '(macro . #[(name arglist func &optional doc) " >!! B >ʪD !%)" [&key arglist error "&key not allowed in define-modify-macro" gensym "--place--" place defmacro* name doc list* &rest list 'callf quote func cl-arglist-args] 11 "\ (define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro. If NAME is called, it combines its PLACE argument with the other arguments from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"])) (fset 'defstruct '(macro . #[(struct &rest descs) ":@ !P \"!  \"! \"!  \"! \"! !\"#$%@; D%A%@F\"B\"%\"B%\ni\n@:\n!\n@\nA@-.=-e-@-@!e.=-A- B e-e-@ .=--@.=--@.=-@-A\"\"!.=-@.=-@ .=!.=-@\"%%.\"*@ADBCDE EN ?FʁG \"CEDSHNINJKL\" K@ =M \"!JN!#J>A@ZOJPQ%%\"\"%K@ Q%!RK! !SDE\"B\"*  T>U \"! V W!!PQ%%\"%XD\"B\"!%GQ%%>GZY V=Z[\\]%GE^_BYEEFY`U^aEZb^cYBEEE)#`Vd#!e=fUZg#!B#$`%hYhahAh@i@jk> BjQ=D BXjhlj #ʁmj#!nj BiA@ BopnqO$r$ʁsn #BEEC V=_BYEY`UtcYBEC\"$\"B\"nBBunvRwxi!>!ʁyn\"DzB DnD$$DYF\"B\"Fʁ{j\"CE|nBDCED)*YTY9*  #p}#@Z=O#~\"Z#EF\"B\"BBF\"B\"BB  PÁ !\"BD B   !R A @!--! #p o%BD-# BF\"B\"ꁌ%\"B! BB,DAZ#EEDE\"B\"DDE\"B\"o D%DF D !=DDF DFꁙ\"&\"B\" D\"B.B" [struct name opts nil slots defaults symbol-name "-" conc-name intern format "make-%s" constructor constrs "copy-%s" copier "%s-p" predicate print-func print-auto cl-compiling-file cl-optimize-safety 3 safety include "cl-struct-%s" tag "cl-struct-%s-tags" tag-symbol include-descs include-tag-symbol side-eff type named forms pred-form pred-check descs put quote 'structure-documentation (cl-tag-slot) mapcar #[(x) ":C" [x] 1] caar args opt :conc-name "" :constructor :copier :predicate :include #[(x) ":C" [x] 1] :print-function :type :named t :initial-offset make-list (cl-skip-slot) error "Slot option %s unrecognized" progn funcall function cl-x cl-s cl-n cl-struct-print princ "#S(%s" cl-struct-type cl-struct-slots old-descs inc-type "%s is not a struct name" ":type disagrees with :include for %s" "No slot %s in included struct %s" append delq cl-tag-slot cadr pushnew (vector list) "Illegal :type specifier: %s" vector true defvar pos and (vectorp cl-x) >= (length cl-x) memq aref 0 (car-safe cl-x) (consp cl-x) nth caadr vectorp 1 cdddr descp desc slot (cl-tag-slot cl-skip-slot) "Duplicate slots named %s in %s" "%s%s" accessor list* defsubst* (cl-x) or "%s accessing a non-%s" (car cl-x) define-setf-method (cl-x) :read-only cddr "%s is a read-only slot" cl-struct-setf-expander " %s" prin1 (cl-x) (t) error-free defun (x) (copy-sequence x) &key copy-sequence cl-arglist-args anames mapcar* #[(s d) " >\n" [s anames d] 2] make &cl-defs cl-safe-expr-p second (princ ")" cl-s) push lambda (cl-x cl-s cl-n) custom-print-functions setq list eval-when (compile load eval) 'cl-struct-slots 'cl-struct-type 'cl-struct-print #[(x) "\n@D\nADF" [put quote x 'side-effect-free] 5]] 13 "\ (defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type. This macro defines a new Lisp data type called NAME, which contains data stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME' copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors."])) (fset 'cl-struct-setf-expander #[(x name accessor pred-form pos) "!!\nC C C\n##\nEECN@=\n FX\nSYDn)\nE EC#\nD*" [gensym "--x--" temp "--store--" store x append (progn) pred-form or subst cl-x error format "%s storing a non-%s" accessor name cl-struct-type vector aset pos setcar 5 xx 0 cdr nthcdr] 12]) (fset 'deftype '(macro . #[(name args &rest body) " # B#E" [eval-when (compile load eval) cl-transform-function-property name cl-deftype-handler list* &cl-defs '('*) args body] 9 "\ (deftype NAME ARGLIST BODY...): define NAME as a new data type. The type name can then be used in `typecase', `check-type', etc."])) (fset 'cl-make-type-test #[(val type) ">9N N \">= D= D= D= D!P!! DP! D*@N @NA\"\"> @\"!>ت!: !E !E!>ت!: !E !EF\">@A\"B> ADEE=! D\"" [type (character string-char) (integer 0 255) cl-deftype-handler cl-make-type-test val (nil t) null float floatp-safe real numberp fixnum integerp symbol-name name intern "p" namep fboundp "-p" apply (integer float real number) delq t and cadr (* nil) > caadr >= caddr (* nil) < caaddr <= (and or not) mapcar #[(x) " \n\"" [cl-make-type-test val x] 3] (member member*) member* quote satisfies error "Bad type spec: %s"] 9]) (fset 'typep #[(val type) " \"!" [eval cl-make-type-test val type] 4 "\ Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier."]) (fset 'check-type '(macro . #[(form type &optional string) " W U \" \n\"\nD DFEE =E DCF*" [cl-compiling-file cl-optimize-speed 3 cl-optimize-safety cl-simple-expr-p form gensym temp or cl-make-type-test type signal 'wrong-type-argument list string quote body progn nil let] 9 "\ Verify that FORM is of type TYPE; signal an error if not. STRING is an optional description of the desired type."])) (fset 'assert '(macro . #[(form &optional show-args string &rest args) " W U  A\"\"\n   \n\"# D\n#EEE)" [cl-compiling-file cl-optimize-speed 3 cl-optimize-safety show-args delq nil mapcar #[(x) " !? " [cl-const-expr-p x] 2] form sargs progn or string list* error append args signal 'cl-assertion-failed list quote] 9 "\ Verify that FORM returns non-nil; signal an error if not. Second arg SHOW-ARGS means to include arguments of FORM in message. Other args STRING and ARGS... are arguments to be passed to `error'. They are not evaluated unless the assertion fails. If STRING is omitted, a default message listing FORM itself is used."])) (fset 'ignore-errors '(macro . #[(&rest body) "  BF)" [gensym err condition-case progn body (error nil)] 4 "\ Execute FORMS; if an error occurs, return nil. Otherwise, return result of last FORM."])) (byte-code "MMMMMMMMMM" [(car cdr nth aref elt if and or + - 1+ 1- min max car-safe cdr-safe progn prog1 prog2) cl-simple-funcs (* / % length memq list vector vectorp < > <= >= = error) cl-safe-funcs cl-simple-expr-p #[(x &optional size) "\n:\n@>\n@9\n@ >\n@NS\nA\n@\"q\n?YVS" [size 10 x (quote function function*) cl-simple-funcs side-effect-free cl-simple-expr-p 0] 3] cl-simple-exprs-p #[(xs) "@!At?" [xs cl-simple-expr-p] 3] cl-safe-expr-p #[(x) ":@>??@9@\n>@ >@NA@!t?" [x (quote function function*) cl-simple-funcs cl-safe-funcs side-effect-free cl-safe-expr-p] 2] cl-const-expr-p #[(x) ":@=@>A@9A@=ć9>ƇƇ" [x quote (function function*) lambda func (nil t) t] 2] cl-const-exprs-p #[(xs) "@!At?" [xs cl-const-expr-p] 3] cl-const-expr-val #[(x) " != : A@ " [cl-const-expr-p x t] 2] cl-expr-access-order #[(x v) " !\n : A @\n\"r\n \n@=\nAć" [cl-const-expr-p x v cl-expr-access-order (t)] 3] cl-expr-contains #[(x y) " ‡ : > A@\"\\m V )LJ" [y x 1 (quote function function*) 0 sum cl-expr-contains nil] 4] cl-expr-contains-any #[(x y) "\n@\"Ao" [y cl-expr-contains x] 3] cl-expr-depends-p #[(x y) " !? !? \"" [cl-const-expr-p x cl-safe-expr-p cl-expr-contains-any y] 3]] 2) (fset 'define-compiler-macro '(macro . #[(func args &rest body) "<D : A@ Br  D*>\"B B#DEDFEF" [args &rest nil res p eval-when (compile load eval) cl-transform-function-property func cl-compiler-macro &whole delq --cl-whole-arg-- body or get quote 'byte-compile put 'byte-compile 'cl-byte-compile-compiler-macro] 9 "\ (define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro. This is like `defmacro', but macro expansion occurs only if the call to FUNC is compiled (i.e., not interpreted). Compiler macros should be used for optimizing the way calls to FUNC are compiled; the form returned by BODY should do the same thing as a call to the normal function called FUNC, though possibly more efficiently. Note that, like regular macros, compiler macros are expanded repeatedly until no further expansions are possible. Unlike regular macros, BODY can decide to \"punt\" and leave the original function call alone by declaring an initial `&whole foo' parameter and then returning foo."])) (byte-code "MM" [compiler-macroexpand #[(form) "9 N ! K= KA@! K\\\n\nA#=?*E" [form nil handler func cl-compiler-macro fboundp autoload load apply] 6] cl-byte-compile-compiler-macro #[(form) "!=!!" [form compiler-macroexpand byte-compile-normal-call byte-compile-form] 3]] 2) (fset 'defsubst* '(macro . #[(name args &rest body) " ! B!? @\"= Am ? $\nD #D\n\"? >\n&F $E," [cl-arglist-args args argns p progn body pbody cl-safe-expr-p unsafe cl-expr-contains 1 define-compiler-macro name list* &whole cl-whole &cl-quote cl-defsubst-expand quote block cl-expr-access-order &key defun*] 13 "\ (defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. Like `defun', except the function is automatically declared `inline', ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...)."])) (byte-code "M##N##N##N##N##N##N##N#\"!\"\"!" [cl-defsubst-expand #[(argns body simple whole unsafe &rest argvs) " B! ! #\"  E)" [whole cl-safe-expr-p progn argvs cl-simple-exprs-p t simple delq nil mapcar* #[(argn argv) "\n!\n # \nD \nD" [simple cl-const-expr-p argv subst argn body unsafe] 4] argns lets let body] 7] put eql byte-compile nil cl-compiler-macro #[(form a b) " != ! E E)!=! E E) \" D E EF !\"D E EF " [cl-const-expr-p a t cl-const-expr-val val equal b eq cl-simple-expr-p 5 if numberp cl-safe-expr-p form] 7] cl-byte-compile-compiler-macro member* #[(form a list &rest keys) "GU@=A@!=E =E =!=!!ʪE!=!ωA@DE@!@@9A]EE+)" [keys 2 :test cl-const-expr-val test eq memq a list equal member eql cl-const-expr-p t floatp-safe nil mq mb p quote form] 5] assoc* #[(form a list &rest keys) "GU@=A@!=E =E!= =!!EE)" [keys 2 :test cl-const-expr-val test eq assq a list equal assoc cl-const-expr-p t eql floatp-safe form] 4] adjoin #[(form a list &rest keys) " !\n! > \n $\n \nEF " [cl-simple-expr-p a list :key keys if list* member* cons form] 6] list* #[(--cl-whole-arg-- arg &rest others) " \nB!@ A @ Er *" [reverse arg others args form cons] 4] get* #[(--cl-whole-arg-- sym prop &optional def) " D F E" [def getf symbol-plist sym prop get] 4] typep #[(form val type) " ! !\" \"> ! \n\n DC\n #E)) " [cl-const-expr-p type cl-make-type-test val cl-const-expr-val res cl-expr-contains (nil 1) cl-simple-expr-p gensym temp let subst form] 6] mapcar #[(y) " @# @# @ !9 !D !DEE ABE#" [put y side-effect-free t byte-compile cl-byte-compile-compiler-macro cl-compiler-macro lambda (w x) cadr list quote caddr x] 11] ((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x) (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x) (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0) (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr) (caaar car caar) (caadr car cadr) (cadar car cdar) (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr) (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar) (caaadr car caadr) (caadar car cadar) (caaddr car caddr) (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar) (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr) (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar) (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr)) proclaim (inline floatp-safe acons map concatenate notany notevery cl-set-elt revappend nreconc gethash) #[(x) " #" [put x side-effect-free t] 4] (oddp evenp abs expt signum last butlast ldiff pairlis gcd lcm isqrt floor* ceiling* truncate* round* mod* rem* subseq list-length get* getf gethash hash-table-count) #[(x) " #" [put x side-effect-free error-free] 4] (eql floatp-safe list* subst acons equalp random-state-p copy-tree sublis hash-table-p) run-hooks cl-macs-load-hook] 4)