;ELC ;;; compiled by jwz@thalidomide on Tue Oct 19 23:13:36 1993 ;;; from file /th/jwz/emacs19/lisp/utils/cl-extra.el ;;; emacs version 19.9 Lucid. ;;; bytecomp version 2.20; 18-oct-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 " >!MM" [cl-19 features error "Tried to load `cl-extra' 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])] 2) (fset 'coerce #[(x type) "=\n<\n\n\"=\n!\n\n!=\n;\n\n=\n!\n\n!=\n;\nGU\nH=\n9\n!\"=\n!\n\"\n\n#" [type list x append nil vector vectorp vconcat string array arrayp character 1 0 coerce symbol-name float typep error "Can't coerce %s to type %s"] 4 "\ Coerce OBJECT to type TYPE. TYPE is a Common Lisp type specifier."]) (fset 'equalp #[(x y) " =‡; ;G GU    U:: :A@ A@\"j:? \"! !G GUG SY H H\"n W) " [x y t equalp vectorp i 0] 4 "\ T if two Lisp objects have similar structures and contents. This is like `equal', except that it accepts numerically equal numbers of different types (float vs. integer), and also compares strings case-insensitively."]) (fset 'cl-mapcar-many #[(cl-func cl-seqs) "AA\"\" !   ! W      @: @@ @A @ H A  A S \"\nB T 6\n.@A@GG^  T W:A@ H:A@ H\"\nBG*\n+" [cl-seqs nil cl-res apply min mapcar length cl-n 0 cl-i copy-sequence cl-args cl-p1 cl-p2 cl-func cl-y cl-x -1] 6]) (fset 'map #[(cl-type cl-func cl-seq &rest cl-rest) "\n $ \")" [apply mapcar* cl-func cl-seq cl-rest cl-res cl-type coerce] 5 "\ Map a function across one or more sequences, returning a sequence. TYPE is the sequence type to return, FUNC is the function, and SEQS are the argument sequences."]) (fset 'maplist #[(cl-func cl-list &rest cl-rest) "\n!B > \"B  l A@Ar+\n\n!B\nAq)" [cl-rest nil cl-list copy-sequence cl-p cl-args cl-res apply cl-func] 5 "\ Map FUNC to each sublist of LIST or LISTS. Like `mapcar', except applies to lists and their cdr's rather than to the elements themselves."]) (fset 'mapc #[(cl-func cl-seq &rest cl-rest) " % \" " [cl-rest apply map nil cl-func cl-seq mapcar] 6 "\ Like `mapcar', but does not accumulate values returned by the function."]) (fset 'mapl #[(cl-func cl-list &rest cl-rest) " $  ! Av) " [cl-rest apply maplist cl-func cl-list cl-p] 6 "\ Like `maplist', but does not accumulate values returned by the function."]) (fset 'mapcan #[(cl-func cl-seq &rest cl-rest) " $\"" [apply nconc mapcar* cl-func cl-seq cl-rest] 7 "\ Like `mapcar', but nconc's together the values returned by the function."]) (fset 'mapcon #[(cl-func cl-list &rest cl-rest) " $\"" [apply nconc maplist cl-func cl-list cl-rest] 7 "\ Like `maplist', but nconc's together the values returned by the function."]) (fset 'some #[(cl-pred cl-seq &rest cl-rest) " <Í  A@!q )" [cl-rest cl-seq cl-some (byte-code " %‡" [apply map nil #[(&rest cl-x) " \n\" \")" [apply cl-pred cl-x cl-res throw cl-some] 4] cl-seq cl-rest] 6) nil cl-x cl-pred] 3 "\ Return true if PREDICATE is true of any element of SEQ or SEQs. If so, return the true (non-nil) value returned by PREDICATE."]) (fset 'every #[(cl-pred cl-seq &rest cl-rest) " <Í @! At ?" [cl-rest cl-seq cl-every (byte-code " %Ƈ" [apply map nil #[(&rest cl-x) " \n\"\"" [apply cl-pred cl-x throw cl-every nil] 3] cl-seq cl-rest t] 6) cl-pred] 3 "\ Return true if PREDICATE is true of every element of SEQ or SEQs."]) (fset 'notany #[(cl-pred cl-seq &rest cl-rest) "\n $?" [apply some cl-pred cl-seq cl-rest] 5 "\ Return true if PREDICATE is false of every element of SEQ or SEQs."]) (fset 'notevery #[(cl-pred cl-seq &rest cl-rest) "\n $?" [apply every cl-pred cl-seq cl-rest] 5 "\ Return true if PREDICATE is false of some element of SEQ or SEQs."]) (byte-code "MMMMMMM" [cl-map-keymap #[(cl-func cl-map) "9Kw = \"< A: @: @@ @A\"i @! @\"[ @=UɉQ)  T GW Ho   H\"d)" [cl-map cl-emacs-type lucid map-keymap cl-func cl-p vectorp cl-map-keymap keymap nil -1 cl-i] 5] cl-map-keymap-recursively #[(cl-func-rec cl-map &optional cl-base) "\n=Ī!\"" [cl-base copy-sequence cl-emacs-type 18 "0" [0] cl-map-keymap #[(cl-key cl-bind) "GS I ! =ȪC\"#  \"" [cl-base cl-key keymapp cl-bind cl-map-keymap-recursively cl-func-rec cl-emacs-type 18 concat vconcat 0] 6] cl-map] 3] cl-map-intervals #[(cl-func &optional cl-what cl-prop cl-start cl-end) "p!‰q e!\n\n!) W!  #\"qd)! “ ^ \"5‰‰,  \nG\n \nW!   # \"\n \n^\"  )M" [cl-what bufferp nil t cl-next2 cl-next cl-mark2 cl-mark copy-marker cl-start cl-end fboundp next-property-change cl-prop next-single-property-change cl-func marker-position 0] 6] cl-map-overlays #[(cl-func &optional cl-buffer cl-start cl-end cl-arg) "p!q  !!) @ A @! @!Y @! X\n @ \" AS ÉÉ)q e!)q!)É  !   dWq ! !Ó) V @! U\n @ \"É= Aa5É  É," [cl-buffer fboundp overlay-lists nil cl-ovl cl-start copy-marker cl-end overlay-start overlay-end cl-func cl-arg cl-pos cl-mark2 cl-mark marker-position overlays-at next-overlay-change] 5] cl-set-frame-visible-p #[(frame val) "\n!=\n!\n!" [val make-frame-invisible frame icon iconify-frame make-frame-visible] 2] cl-progv-before #[(syms values) "@!@@JB@\nB A@ A@LYA@!O" [syms boundp cl-progv-save values makunbound] 3] cl-progv-after #[nil "@:@@@AL@!Ab" [cl-progv-save makunbound] 2]] 2) (fset 'gcd #[(&rest args) " A@! A@!V s)d )" [abs args 0 a b] 4 "\ Return the greatest common divisor of the arguments."]) (fset 'lcm #[(&rest args) " > A@! A@! \" _)i )" [0 args abs 1 a b gcd] 4 "\ Return the least common multiple of the arguments."]) (fset 'isqrt #[(a) "VYYĪYŪ  \\ʥ W j *=\"" [a 0 1000000 10000 1000 100 10 nil g2 g 2 signal arith-error] 4 "\ Return the integer square root of the argument."]) (fset 'cl-expt #[(x y) "XU‡ > ŦUª _ť\"_" [y 0 1 x (-1 1) 2 cl-expt] 5 "\ Return X raised to the power of Y. Works only for integer arguments."]) (byte-code "!K!\"" [fboundp expt subrp defalias cl-expt] 3) (fset 'floor* #[(x &optional y) "  YY  D Y ZZ[[Y ZZ[ [[ _Z)D ! _Z)D D ! Z)D" [y x 0 1 q floor] 5 "\ Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient."]) (fset 'ceiling* #[(x &optional y) " \n\"A@U @T A@\nZD)" [floor* x y res 0 1] 4 "\ Return a list of the ceiling of X and the fractional part of X. With two arguments, return ceiling and remainder of their quotient."]) (fset 'truncate* #[(x &optional y) "Y\n?\nY=\n\"\n\"" [x 0 y floor* ceiling*] 3 "\ Return a list of the integer part of X and the fractional part of X. With two arguments, return truncation and remainder of their quotient."]) (fset 'round* #[(x &optional y) " ¥ \\\"A@U \\U @¦U @S D @ A@ ZD* ! _Z)D D ! Z)D" [y x 2 hy floor* res 0 round q] 5 "\ Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient."]) (fset 'mod* #[(x y) " \n\"A@" [floor* x y] 3 "\ The remainder of X divided by Y, with the same sign as Y."]) (fset 'rem* #[(x y) " \n\"A@" [truncate* x y] 3 "\ The remainder of X divided by Y, with the same sign as X."]) (fset 'signum #[(a) "V‡WÇ" [a 0 1 -1] 2 "\ Return 1 if A is positive, -1 if negative, 0 if zero."]) (fset 'random* #[(lim &optional state) " H !ǦZ\n   \"I  I \\Ϧ V     Z  I` T W\"o,HTϦI HTϦI   H  HZI\"XV\"\"\\SW\\Tp\"W\")ݥ_," [state *random-state* 3 vec 0 1357335 abs 1357333 1 nil ii k j i make-vector 55 21 200 random* 2 logand 8388607 n lim 512 lsh 9 1023 mask 8388608.0] 7 "\ Return a random nonnegative number less than LIM, an integer or float. Optional second arg STATE is a random-state object."]) (fset 'make-random-state #[(&optional state) "\n!!\"$ !" [state make-random-state *random-state* vectorp cl-copy-tree t vector cl-random-state-tag -1 30 cl-random-time] 5 "\ Return a copy of random-state STATE, or of `*random-state*' if omitted. If STATE is t, return a new state object seeded from the time of day."]) (fset 'random-state-p #[(object) " ! GU H=" [vectorp object 4 0 cl-random-state-tag] 2 "\ Return t if OBJECT is a random-state object."]) (byte-code "MM" [cl-finite-do #[(func a b) "" [err (byte-code " \n\" ĥU? )" [func a b res 2] 4) ((arith-error))] 3] cl-float-limits #[nil "É#_pɥ#ɥ_l#\\pɥ # \\U \\ ɥc[    _Ϗɥ ɥn  [ ԏɥr[\\Uɥq\\ZUɥp\\+Ç" [most-positive-float 20.0 2.0 nil z y x cl-finite-do * 2 + most-negative-float 16 err (byte-code "_U\nV" [x 2 y 0] 3) ((arith-error)) least-positive-normalized-float least-negative-normalized-float 1 (byte-code "V" [x 2 0] 2) ((arith-error)) least-positive-float least-negative-float 1.0 1.0 1.0 float-epsilon 1.0 1.0 1.0 float-negative-epsilon] 6]] 2) (fset 'subseq #[(seq start &optional end) "; \nO\n\nW\nG\\ W G\\< V \n\nS YA@Bl)!\n G\n Z]\"  \nW  HI T Th*)" [seq start end nil len 0 res copy-sequence make-vector i] 5 "\ Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end."]) (fset 'concatenate #[(type &rest seqs) "= \"= \"=ȉ \"\"\"" [type vector apply vconcat seqs string concat list append (nil) error "Not a sequence type name: %s"] 5 "\ Concatenate, into a sequence of type TYPE, the argument SEQUENCES."]) (fset 'revappend #[(x y) " !\n" [reverse x y] 2 "\ Equivalent to (append (reverse X) Y)."]) (fset 'nreconc #[(x y) " " [x y] 2 "\ Equivalent to (nconc (nreverse X) Y)."]) (fset 'list-length #[(x) "  A \n= V \\ AA\nAe A? T +" [0 x slow fast n 2] 3 "\ Return the length of a list. Return nil if list is circular."]) (fset 'tailp #[(sublist list) ": =Ar  =" [list sublist] 3 "\ Return true if SUBLIST is a tail of LIST."]) (fset 'cl-copy-tree #[(tree &optional vecp) ":!\n:\n@: \n@!\n\n@ \"\nA<\n\nA \"\nAR) !!GSYH \"Ih)" [tree copy-list p vecp vectorp cl-copy-tree copy-sequence i 0] 5 "\ Make a copy of TREE. If TREE is a cons cell, this recursively copies both its car and its cdr. Constrast to copy-sequence, which copies only along the cdrs. With second argument VECP, this copies vectors as well as conses."]) (byte-code "!K!\"" [fboundp copy-tree subrp defalias cl-copy-tree] 3) (fset 'get* #[(sym tag &optional def) " N\n! @ = AAs A@\n)" [sym tag def symbol-plist plist] 3 "\ Return the value of SYMBOL's PROPNAME property, or DEFAULT if none."]) (fset 'getf #[(plist tag &optional def) "\n\" N #" [setplist --cl-getf-symbol-- plist tag def get*] 4 "\ Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'."]) (byte-code "MM" [cl-set-getf #[(plist tag val) " @\n= AAs A \n #)" [plist p tag val list*] 5] cl-do-remf #[(plist tag) "AA A@\n= AAo A AAA)" [plist p tag t] 3]] 2) (fset 'cl-remprop #[(sym tag) " ! \n@= \nAA\"Ū\n \")" [symbol-plist sym plist tag setplist t cl-do-remf] 4 "\ Remove from SYMBOL's plist the property PROP and its value."]) (byte-code "!K!\"" [fboundp remprop subrp defalias cl-remprop] 3) (fset 'make-hash-table #[(&rest cl-keys) " >A@ >A@=! ! V \"!L)F*" [:test cl-keys eql :size 20 cl-size cl-test eq fboundp make-hashtable cl-hash-table-tag 1 make-vector 0 make-symbol "--hashsym--" sym nil] 6 "\ Make an empty Common Lisp-style hash-table. If :test is `eq', this can use Lucid Emacs built-in hash-tables. In non-Lucid Emacs, or with non-`eq' test, this internally uses a-lists. Keywords supported: :test :size The Common Lisp keywords :rehash-size and :rehash-threshold are ignored."]) (byte-code "!!!!!H!" [boundp cl-lucid-hash-tag fboundp make-hashtable vectorp 1 0 make-symbol "--cl-hash-tag--"] 3) (fset 'hash-table-p #[(x) "=!GUH =!!" [x cl-hash-table-tag vectorp 4 0 cl-lucid-hash-tag fboundp hashtablep] 2 "\ Return t if OBJECT is a hash table."]) (byte-code "MM!!K!K!!K!K !!K!K !!K!K " [cl-not-hash-table #[(x &optional y &rest z) " D\"" [signal wrong-type-argument hash-table-p y x] 4] cl-hash-lookup #[(key table) "=!8A@ 9 J :!GV˜g; =9!VW!\"H \"J  = = > \" $ E," [table cl-hash-table-tag cl-not-hash-table 2 array test key str nil sym vectorp 0 equalp symbol-name -8000000 8000000 truncate ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15"] logand 15 "*" intern-soft eq eql (eql equal) assoc assoc* :test] 6] boundp cl-builtin-gethash fboundp gethash subrp cl-builtin-remhash remhash cl-builtin-clrhash clrhash cl-builtin-maphash maphash] 2) (fset 'cl-gethash #[(key table &optional def) ":\n\"@ @A ) \n #" [table cl-hash-lookup key found def cl-builtin-gethash] 5 "\ Look up KEY in HASH-TABLE; return corresponding value, or DEFAULT."]) (byte-code "\"M" [defalias gethash cl-gethash cl-puthash #[(key val table) ":\n\"@ @ 888G_V8\" 8\"AA ) 88\"\n B A@BL8\n B A@BLAAA8T)\n # " [table cl-hash-lookup key found val 2 3 make-vector 0 new-table mapatoms #[(sym) "\n! \"\nJL" [intern symbol-name sym new-table] 3] intern puthash] 5]] 3) (fset 'cl-remhash #[(key table) ":\n\"@ @ A@\"AAA8S 8 88\" L8 L))\n\n#=? \n\"" [table cl-hash-lookup key found delq del 3 2 intern t cl-builtin-gethash --cl-- cl-builtin-remhash] 5 "\ Remove KEY from HASH-TABLE."]) (defalias 'remhash 'cl-remhash) (fset 'cl-clrhash #[(table) ":!!898LAA8G\"AAAƠ!ć" [table hash-table-p cl-not-hash-table 2 nil make-vector 0 cl-builtin-clrhash] 4 "\ Clear HASH-TABLE."]) (defalias 'clrhash 'cl-clrhash) (fset 'cl-maphash #[(cl-func cl-table) " ! ! : 89 8! 8\" \"" [hash-table-p cl-table cl-not-hash-table mapatoms #[(cl-x) "J @@@A\"Aq‡" [cl-x cl-func nil] 4] 2 vector cl-builtin-maphash cl-func] 5 "\ Call FUNCTION on keys and values from HASH-TABLE."]) (defalias 'maphash 'cl-maphash) (fset 'hash-table-count #[(table) " ! ! : 8 !" [hash-table-p table cl-not-hash-table 3 hashtable-fullness] 2 "\ Return the number of entries in HASH-TABLE."]) (fset 'cl-prettyprint #[(form) "` !ñ`\nTb #!c !i\nTb *" [nil last pt "\n" prin1-to-string form search-forward "(quote " t delete-backward-char 7 "'" forward-sexp delete-char 1 cl-do-prettyprint] 4 "\ Insert a pretty-printed rendition of a Lisp FORM in current buffer."]) (byte-code "M!!ć" [cl-do-prettyprint #[nil "w!!!!!!!!!!! iY u ! ! !?c cu), " [" " nil looking-at "(" "((" "(prog" "(unwind-protect " "(function (" "(cl-block-wrapper " "(defun " "(defmacro " "(let\\*? " "(while " "(p?set[qf] " set let two skip forward-sexp 78 backward-sexp t nl 1 cl-do-prettyprint ")" "\n" lisp-indent-line] 6] boundp cl-macroexpand-cmacs nil cl-closure-vars] 2) (fset 'cl-macroexpand-all #[(form &optional env) "\n\"=v !=j:@>A@!B\n\"ɉ!     @: !\n\"9  !\n\")B @\n\"9 D) B  A 8 @=ͪժ@ !\n\"#+@=@A\"B@=@A@8\n\"!\"$@>tA@=r!\n\" !@= !\"!\"%!%\"'( @; @= A @D(B(b!!@#E'(\"%!\"' \"#DE!\"$C#+@! #D)@>@A@!\n\"#@=!A@\n\"@=A\n\":;;@9;!;q;:B!:B*@A\n\"B" [form macroexpand env cl-macroexpand-cmacs compiler-macroexpand (let let*) cl-macroexpand-all progn cddr nil cadr lets res letf caar exp t cl-macroexpand-body cdar list* let letf* cond mapcar #[(x) " \n\"" [cl-macroexpand-body x env] 3] condition-case 2 #[(x) "@A\n\"B" [x cl-macroexpand-body env] 4] cdddr 'function lambda cddadr body cl-closure-vars function cl-expr-contains-any gensym new pairlis sub decls interactive quote put last used append list 'lambda '(&rest --cl-rest--) sublis 'apply 'quote cadadr #[(x) "\nE" [list 'quote x] 3] ('--cl-rest--) (defun defmacro) setq args p setf] 16 "\ Expand all macro calls through a Lisp FORM. This also does some trivial optimizations to make the form prettier."]) (byte-code "MM!" [cl-macroexpand-body #[(body &optional env) "\n\"" [mapcar #[(x) " \n\"" [cl-macroexpand-all x env] 3] body] 3] cl-prettyexpand #[(form &optional full) "!\n\n?\"!!!+" [message "Expanding..." full nil byte-compile-macro-environment cl-compiling-file cl-macroexpand-cmacs cl-macroexpand-all form ((block) (eval-when)) "Formatting..." cl-prettyprint ""] 3] run-hooks cl-extra-load-hook] 2)