;ELC ;;; compiled by jwz@thalidomide on Thu Dec 2 20:24:33 1993 ;;; from file /th/jwz/emacs19/lisp/edebug/cust-print.el ;;; emacs version 19.9.24 Lucid. ;;; bytecomp version 2.20; 20-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.")) (provide 'cust-print) (defvar print-level nil "\ *Controls how many levels deep a nested data object will print. If nil, printing proceeds recursively and may lead to max-lisp-eval-depth being exceeded or an untrappable error may occur: \"Apparently circular structure being printed.\" Also see print-length and print-circle. If non-nil, components at levels equal to or greater than print-level are printed simply as \"#\". The object to be printed is at level 0, and if the object is a list or vector, its top-level components are at level 1.") (defvar print-circle nil "\ *Controls the printing of recursive structures. If nil, printing proceeds recursively and may lead to max-lisp-eval-depth being exceeded or an untrappable error may occur: \"Apparently circular structure being printed.\" Also see print-length and print-level. If non-nil, shared substructures anywhere in the structure are printed with \"#n=\" before the first occurance (in the order of the print representation) and \"#n#\" in place of each subsequent occurance, where n is a positive decimal integer. Currently, there is no way to read this representation in Emacs.") (defvar custom-print-vectors nil "\ *Non-nil if printing of vectors should obey print-level and print-length. For Emacs 18, setting print-level, or adding custom print list or vector handling will make this happen anyway. Emacs 19 obeys print-level, but not for vectors.") (defconst custom-print-list nil "\ If non-nil, an alist for printing of custom list objects. Pairs are of the form (pred . converter). If the predicate is true for an object, the converter is called with the object and should return a string which will be printed with princ. Also see custom-print-vector.") (defconst custom-print-vector nil "\ If non-nil, an alist for printing of custom vector objects. Pairs are of the form (pred . converter). If the predicate is true for an object, the converter is called with the object and should return a string which will be printed with princ. Also see custom-print-list.") (fset 'add-custom-print-list #[(pred converter) " B ž \"B‰‡" [pred converter delq custom-print-list] 4 "\ Add the pair, a PREDICATE and a CONVERTER, to custom-print-list. Any pair that has the same PREDICATE is first removed."]) (fset 'add-custom-print-vector #[(pred converter) " B ž \"B‰‡" [pred converter delq custom-print-vector] 4 "\ Add the pair, a PREDICATE and a CONVERTER, to custom-print-vector. Any pair that has the same PREDICATE is first removed."]) (byte-code "ÀÁMˆÂÃMˆÄÅ!¬…ÆÀÇ\"ˆÀ‡" [CP::set-function-cell #[(symbol-pair) "@A@KM‡" [symbol-pair] 2] CP::internal-princ (lambda (object &optional stream)) fboundp CP::internal-prin1 mapcar ((CP::internal-prin1 prin1) (CP::internal-princ princ) (CP::internal-print print) (CP::internal-prin1-to-string prin1-to-string) (CP::internal-format format) (CP::internal-message message) (CP::internal-error error))] 3) (fset 'install-custom-print-funcs #[nil "ÀÁÂ\"‡" [mapcar CP::set-function-cell ((prin1 custom-prin1) (princ custom-princ) (print custom-print) (prin1-to-string custom-prin1-to-string) (format custom-format) (message custom-message) (error custom-error))] 3 "\ Replace print functions with general, customizable, lisp versions. The internal subroutines are saved away and may be recovered with uninstall-custom-print-funcs." nil]) (fset 'uninstall-custom-print-funcs #[nil "ÀÁÂ\"‡" [mapcar CP::set-function-cell ((prin1 CP::internal-prin1) (princ CP::internal-princ) (print CP::internal-print) (prin1-to-string CP::internal-prin1-to-string) (format CP::internal-format) (message CP::internal-message) (error CP::internal-error))] 3 "\ Reset print functions to their internal subroutines." nil]) (fset 'custom-print-funcs-installed-p #[nil "ÀKÁK=‡" [custom-prin1 prin1] 2 "\ Return t if custom-print functions are currently installed, nil otherwise."]) (byte-code "ÀÁÂÃ#ˆÂÄM‡" [put edebug-form-spec with-custom-print-funcs (body) (macro . #[(&rest body) "ÀÁ \"ÄE‡" [unwind-protect append (progn (install-custom-print-funcs)) body (uninstall-custom-print-funcs)] 4])] 4) (fset 'custom-prin1 #[(object &optional stream) "À \nÃ#‡" [CP::top-level object stream CP::internal-prin1] 4 "\ Replacement for standard prin1 that uses the appropriate printer depending on the values of `print-level' and `print-circle'. Output the printed representation of OBJECT, any Lisp object. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. Output stream is STREAM, or value of `standard-output' (which see)."]) (fset 'custom-princ #[(object &optional stream) "À \nÃ#‡" [CP::top-level object stream CP::internal-princ] 4 "\ Same as custom-prin1 except no quoting."]) (fset 'CP::prin1-to-string-func #[(c) " B‰‡" [c prin1-chars] 2]) (fset 'custom-prin1-to-string #[(object) "À Ä\"ˆ Ÿ°)‡" [nil prin1-chars custom-prin1 object CP::prin1-to-string-func] 3 "\ Replacement for standard prin1-to-string."]) (fset 'custom-print #[(object &optional stream) "ÀÁ\n\"ˆÃ \n\"ˆÀÁ\n\"‡" [CP::internal-princ "\n" stream custom-prin1 object] 3 "\ Replacement for standard print."]) (fset 'custom-format #[(fmt &rest args) "ÀÁ\nÃÄ \"#‡" [apply CP::internal-format fmt mapcar #[(arg) "<¬…Á!«„Â!‡‡" [arg vectorp custom-prin1-to-string] 2] args] 6 "\ Replacement for standard format. Calls format after first making strings for list or vector args. The format specification for such args should be %s in any case, so a string argument will also work. The string is generated with custom-prin1-to-string, which quotes quotable characters."]) (fset 'custom-message #[(fmt &rest args) "ÀÁ\nÃÄ \"#‡" [apply CP::internal-message fmt mapcar #[(arg) "<¬…Á!«„Â!‡‡" [arg vectorp custom-prin1-to-string] 2] args] 6 "\ Replacement for standard message that works like custom-format."]) (fset 'custom-error #[(fmt &rest args) "ÀÁÂà #C\"‡" [signal error apply custom-format fmt args] 6 "\ Replacement for standard error that uses custom-format"]) (byte-code "ÀÁMˆÂÃMˆÄÅMˆÆÇMˆÈÉMˆÊËMˆÌÍMˆÎÏMˆÐÑMˆÒÓMˆÔÕMˆÖ×M‡" [CP::internal-printer (lambda (object)) CP::low-level-prin (lambda (object)) CP::prin (lambda (object)) CP::top-level #[(object stream internal-printer) "® \n­ƒÃ ! ®ÆÉ\nMˆË ¬„ «ƒÎª–¬Ž ¬‹«Š ¬„«ƒÑªÉMˆÒ«ƒÓªËMˆÒ !ˆ +‡" [stream standard-output print-circle CP::preprocess-circle-tree object print-level -1 level circle-table CP::internal-printer internal-printer CP::low-level-prin custom-print-list custom-print-vector CP::custom-object custom-print-vectors print-length CP::object CP::prin CP::circular] 3] CP::object #[(object) "¬„Á!‡:«„Â!‡Ã!«„Ä!‡Á!‡" [object CP::internal-printer CP::list vectorp CP::vector] 2] CP::custom-object #[(object) "¬„Á!‡:«\n«†Ã\n\"®›Ä!‡Å!««‡Ã\"®‡Ç!‡Á!‡" [object CP::internal-printer custom-print-list CP::custom-object1 CP::list vectorp custom-print-vector CP::vector] 3] CP::custom-object1 #[(object alist) "«@@ !¬†A‰¬s­‡Â@A !!‡" [alist object CP::internal-princ] 4] CP::circular #[(object) " ž‰«­\nA‰ÄV«ÅÆ!ˆÅ !ˆÅÆ!ª•\n [¡ˆÅÆ!ˆÅ [!ˆÅÇ!ˆÈ!)ªƒÈ!)‡" [object circle-table tag id 0 CP::internal-princ "#" "=" CP::low-level-prin] 3] CP::list #[(list) "ÁU«†ÂÃ!ˆªõSÂÄ!ˆ ®ÁÇ@!ˆA‰«„ÂÉ!ˆS«ºÁU¬´<«”\nž¬Ç@!ˆAªŒÂË!ˆÇ!ˆÌS«HÂÉ!ˆªB«ŠÁU«„ÂÍ!ˆÂÎ!ˆ*‡" [level 0 CP::internal-princ "#" "(" print-length length CP::prin list " " circle-table ". " nil "..." ")"] 3] CP::vector #[(vector) "ÁU«†ÂÃ!ˆªÄSÁ GÂÇ!ˆ«… ^ W«˜É H!ˆT‰ GW«hÂÊ!ˆªb GW«„ÂË!ˆÂÌ!ˆ+ ‡" [level 0 CP::internal-princ "#" vector len i "[" print-length CP::prin " " "..." "]"] 4] CP::preprocess-circle-tree #[(object) "ÀC !ˆ ‰AŸ¡ˆ ÄA«£A@‰A« ¡ˆ SAª‡‰AA¡ˆ)ªX* A)‡" [nil circle-table CP::walk-circle-tree object -1 id rest tag] 3] CP::walk-circle-tree #[(object) "À‰ ­ß §®‚ 9‰?­„ Až‰«† Å¡ˆª‹\n¬ˆ C AB¡ˆ «ƒÀª° :«‰Æ @!ˆ Aª£Ç !­ž GÈ \n \nW­Æ  H!ˆ T‰ ªl*‰¬\"À*‡" [nil tag read-equivalent-p object circle-table t CP::walk-circle-tree vectorp 0 j i] 4]] 2)