;;; compiled by eric@mole.gnu.ai.mit.edu on Fri Apr 23 03:07:54 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/cust-print.el ;;; emacs version 19.5.1. ;;; bytecomp version FSF 2.08 ;;; optimization is on. (provide (quote custom-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.") (defconst custom-print-list nil "\ An alist for custom printing of lists. Pairs are of the form (PRED . CONVERTER). If PREDICATE is true for an object, then CONVERTER is called with the object and should return a string to be printed with `princ'. Also see `custom-print-vector'.") (defconst custom-print-vector nil "\ An alist for custom printing of vectors. Pairs are of the form (PRED . CONVERTER). If PREDICATE is true for an object, then CONVERTER is called with the object and should return a string to be printed with `princ'. Also see `custom-print-list'.") (defalias 'add-custom-print-list #[(pred converter) " BÂà \" \"B‰‡" [pred converter delq assq custom-print-list] 5 "\ Add a pair of PREDICATE and CONVERTER to `custom-print-list'. Any pair that has the same PREDICATE is first removed."]) (defalias 'add-custom-print-vector #[(pred converter) " BÂà \" \"B‰‡" [pred converter delq assq custom-print-vector] 5 "\ Add a pair of PREDICATE and CONVERTER to `custom-print-vector'. Any pair that has the same PREDICATE is first removed."]) (byte-code "ÀÁMˆÂÃ!„ÄÀÅ\"ˆÀ‡" [cust-print-set-function-cell #[(symbol-pair) "À @ A@K\"‡" [defalias symbol-pair] 3] fboundp cust-print-internal-prin1 mapcar ((cust-print-internal-prin1 prin1) (cust-print-internal-princ princ) (cust-print-internal-print print) (cust-print-internal-prin1-to-string prin1-to-string) (cust-print-internal-format format) (cust-print-internal-message message) (cust-print-internal-error error))] 3) (defalias 'install-custom-print-funcs #[nil "ÀÁÂ\"‡" [mapcar cust-print-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 you can reinstall them by running `uninstall-custom-print-funcs'." nil]) (defalias 'uninstall-custom-print-funcs #[nil "ÀÁÂ\"‡" [mapcar cust-print-set-function-cell ((prin1 cust-print-internal-prin1) (princ cust-print-internal-princ) (print cust-print-internal-print) (prin1-to-string cust-print-internal-prin1-to-string) (format cust-print-internal-format) (message cust-print-internal-message) (error cust-print-internal-error))] 3 "\ Reset print functions to their internal subroutines." nil]) (defalias 'custom-prin1 #[(object &optional stream) "À \nÃ#‡" [cust-print-top-level object stream cust-print-internal-prin1] 4 "\ Replacement for standard `prin1'. Uses the appropriate printer depending on the values of `print-level' and `print-circle' (which see). 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)."]) (defalias 'custom-princ #[(object &optional stream) "À \nÃ#‡" [cust-print-top-level object stream cust-print-internal-princ] 4 "\ Same as `custom-prin1' except no quoting."]) (defalias 'custom-prin1-to-string-func #[(c) " B‰‡" [c custom-prin1-chars] 2 "\ Stream function for `custom-prin1-to-string'."]) (defalias 'custom-prin1-to-string #[(object) "À Ä\"ˆÅÆ !!)‡" [nil custom-prin1-chars custom-prin1 object custom-prin1-to-string-func concat nreverse] 3 "\ Replacement for standard `prin1-to-string'."]) (defalias 'custom-print #[(object &optional stream) "ÀÁ!ˆÂ \"ˆÀÁ!‡" [cust-print-internal-princ "\n" custom-prin1 object stream] 3 "\ Replacement for standard `print'."]) (defalias 'custom-format #[(fmt &rest args) "ÀÁ\nÃÄ \"#‡" [apply cust-print-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."]) (defalias 'custom-message #[(fmt &rest args) "ÀÁ\nÃÄ \"#‡" [apply cust-print-internal-message fmt mapcar #[(arg) "<„ Á!ƒÂ!‡‡" [arg vectorp custom-prin1-to-string] 2] args] 6 "\ Replacement for standard `message' that works like `custom-format'."]) (defalias 'custom-error #[(fmt &rest args) "ÀÁÂà #C\"‡" [signal error apply custom-format fmt args] 6 "\ Replacement for standard `error' that uses `custom-format'"]) (defalias 'cust-print-top-level #[(object stream internal-printer) "† \n… à ! †ÆÉÊ \"ˆÉÌ „,„, ƒ0Ï‚:ƒ9Ђ:Ê\"ˆÉуGÒ‚HÌ\"ˆÑ !ˆ +‡" [stream standard-output print-circle cust-print-preprocess-circle-tree object print-level -1 circle-level circle-table defalias cust-print-internal-printer internal-printer cust-print-low-level-prin custom-print-list custom-print-vector cust-print-custom-object cust-print-object cust-print-prin cust-print-circular] 3 "\ Set up for printing."]) (byte-code "ÀÁMˆÂÃMˆÄÅM‡" [cust-print-object #[(object) "„Á!‡:ƒÂ!‡Ã!ƒÄ!‡Á!‡" [object cust-print-internal-printer cust-print-list vectorp cust-print-vector] 2] cust-print-custom-object #[(object) "„Á!‡:ƒ\nƒÃ\n\"†6Ä!‡Å!ƒ3ƒ/Ã\"†6Ç!‡Á!‡" [object cust-print-internal-printer custom-print-list cust-print-custom-object1 cust-print-list vectorp custom-print-vector cust-print-vector] 3] cust-print-custom-object1 #[(object alist) "ƒ@@ !„A‰„…Â@A !!‡" [alist object cust-print-internal-princ] 4]] 2) (defalias 'cust-print-circular #[(object) "À \n\"‰ƒ: A‰ÅVƒ ÆÇ!ˆÆ !ˆÆÇ!‚6È [\"ˆÆÇ!ˆÆ [!ˆÆÉ!ˆÊ !)‚=Ê !)‡" [assq object circle-table tag id 0 cust-print-internal-princ "#" setcdr "=" cust-print-low-level-prin] 4 "\ Printer for `prin1' and `princ' that handles circular structures. If OBJECT appears multiply, and has not yet been printed, prefix with label; if it has been printed, use `#N#' instead. Otherwise, print normally."]) (byte-code "ÀÁMˆÂÃMˆÄÅMˆÆÇM‡" [cust-print-list #[(list) "ÁUƒ ÂÃ!ˆ‚ŽSÂÄ!ˆ †ÁÇ@!ˆA‰ƒ.ÂÉ!ˆSƒyÁU„y<ƒ\\Ê \"„\\Ç@!ˆA‚hÂÌ!ˆÇ!ˆÍSƒ3ÂÉ!ˆ‚3ƒ‰ÁUƒ‰ÂÎ!ˆÂÏ!ˆ*‡" [circle-level 0 cust-print-internal-princ "#" "(" print-length length cust-print-prin list " " assq circle-table ". " nil "..." ")"] 4] cust-print-vector #[(vector) "ÁUƒ ÂÃ!ˆ‚VSÁ GÂÇ!ˆƒ$ ^ WƒEÉ H!ˆT‰ GWƒ$ÂÊ!ˆ‚$ GWƒQÂË!ˆÂÌ!ˆ+ ‡" [circle-level 0 cust-print-internal-princ "#" vector len i "[" print-length cust-print-prin " " "..." "]"] 4] cust-print-preprocess-circle-tree #[(object) "ÀC !ˆÄ Å A!\"ˆ ÆAƒFA@‰ Aƒ:Ä \"ˆSA‚BĉAA\"ˆ)‚* A)‡" [nil circle-table cust-print-walk-circle-tree object setcdr nreverse -1 id rest tag] 5] cust-print-walk-circle-tree #[(object) "À‰ …{Ä !† 9‰?…Å A\"‰ƒ)Ç È\"ˆ‚8\n„8Ç CAB\"ˆ ƒ@À‚u :ƒOÉ @!ˆ A‚uÊ !…u GË    W…tÉ  H!ˆ T‰ ‚^*‰„À*‡" [nil tag read-equivalent-p object numberp assq circle-table setcdr t cust-print-walk-circle-tree vectorp 0 j i] 5]] 2)