;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:40:38 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/cust-print.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; 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 (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 occurrence (in the order of the print representation) and `#N#' in place of each subsequent occurrence, 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 custom-print-list] 4 "\ 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 custom-print-vector] 4 "\ Add a pair of PREDICATE and CONVERTER to `custom-print-vector'. Any pair that has the same PREDICATE is first removed."]) (byte-code "ÀÁÂ\"ˆÃÄ!„ÅÁÆ\"ˆÀ‡" [defalias 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] 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 "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias 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]] 3) (defalias 'cust-print-circular #[(object) " ž‰ƒ8\nA‰ÄVƒÅÆ!ˆÅ !ˆÅÆ!‚4\n [¡ˆÅÆ!ˆÅ [!ˆÅÇ!ˆÈ!)‚;È!)‡" [object circle-table tag id 0 cust-print-internal-princ "#" "=" cust-print-low-level-prin] 3 "\ 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 "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias cust-print-list #[(list) "ÁUƒ ÂÃ!ˆ‚SÂÄ!ˆ †ÁÇ@!ˆA‰ƒ.ÂÉ!ˆSƒxÁU„x<ƒ[\nž„[Ç@!ˆA‚gÂË!ˆÇ!ˆÌSƒ3ÂÉ!ˆ‚3ƒˆÁUƒˆÂÍ!ˆÂÎ!ˆ*‡" [circle-level 0 cust-print-internal-princ "#" "(" print-length length cust-print-prin list " " circle-table ". " nil "..." ")"] 3] 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ƒ>A@‰Aƒ3 ¡ˆ SA‚:‰AA¡ˆ)‚* A)‡" [nil circle-table cust-print-walk-circle-tree object -1 id rest tag] 3] cust-print-walk-circle-tree #[(object) "À‰ …t §† 9‰?… Až‰ƒ% Å¡ˆ‚1\n„1 C AB¡ˆ ƒ9À‚n :ƒHÆ @!ˆ A‚nÇ !…n GÈ \n \nW…mÆ  H!ˆ T‰ ‚W*‰„À*‡" [nil tag read-equivalent-p object circle-table t cust-print-walk-circle-tree vectorp 0 j i] 4]] 3)