;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:19:56 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cust-print.el ;;; emacs version 19.28.90.69. ;;; 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 "`/gd/gnu/emacs/19.0/lisp/cust-print.el' was compiled for Emacs 19")) (byte-code "!!M" [require backquote fboundp defalias fset] 2) #@492 *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 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-level nil (#$ . -565)) #@618 *Controls the printing of recursive structures. If nil, printing proceeds recursively and may lead to `max-lisp-eval-depth' being exceeded or an 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. There is no way to read this representation in standard Emacs, but if you need to do so, try the cl-read.el package. (defvar print-circle nil (#$ . -1100)) #@238 *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. (defvar custom-print-vectors nil (#$ . -1763)) #@461 An alist for custom printing of any type. Pairs are of the form (PREDICATE . PRINTER). If PREDICATE is true for an object, then PRINTER is called with the object. PRINTER should print to `standard-output' using cust-print-original-princ if the standard printer is sufficient, or cust-print-prin for complex things. The PRINTER should return the object being printed. Don't modify this variable directly. Use `add-custom-printer' and `delete-custom-printer' (defconst custom-printers nil (#$ . 2054)) #@114 Add a pair of PREDICATE and PRINTER to `custom-printers'. Any pair that has the same PREDICATE is first removed. (defalias 'add-custom-printer #[(pred printer) " B \"B " [pred printer delq custom-printers cust-print-update-custom-printers] 4 (#$ . 2564)]) #@54 Delete the custom printer associated with PREDICATE. (defalias 'delete-custom-printer #[(pred) " \n\n\" " [delq pred custom-printers cust-print-update-custom-printers] 3 (#$ . 2834)]) (defalias 'cust-print-use-custom-printer #[(object) "" [nil] 1]) (defalias 'cust-print-update-custom-printers #[nil "\"\"BE\"" [defalias cust-print-use-custom-printer lambda (object) cond append mapcar #[(pair) "@BABD" [pair (object) (object)] 3] custom-printers ((t nil))] 9]) (defalias 'cust-print-set-function-cell #[(symbol-pair) " @ A@K\"" [defalias symbol-pair] 3]) (defalias 'cust-print-original-princ #[(object &optional stream) "" [nil] 1]) (byte-code "! \"" [fboundp cust-print-original-prin1 mapcar cust-print-set-function-cell ((cust-print-original-prin1 prin1) (cust-print-original-princ princ) (cust-print-original-print print) (cust-print-original-prin1-to-string prin1-to-string) (cust-print-original-format format) (cust-print-original-message message) (cust-print-original-error error))] 3) #@170 Replace print functions with general, customizable, Lisp versions. The emacs subroutines are saved away, and you can reinstall them by running `custom-print-uninstall'. (defalias 'custom-print-install #[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)) t] 3 (#$ . 3872) nil]) #@51 Reset print functions to their emacs subroutines. (defalias 'custom-print-uninstall #[nil "\"Ç" [mapcar cust-print-set-function-cell ((prin1 cust-print-original-prin1) (princ cust-print-original-princ) (print cust-print-original-print) (prin1-to-string cust-print-original-prin1-to-string) (format cust-print-original-format) (message cust-print-original-message) (error cust-print-original-error)) t] 3 (#$ . 4331) nil]) (defalias (quote custom-print-funcs-installed-p) (quote custom-print-installed-p)) #@65 Return t if custom-print is currently installed, nil otherwise. (defalias 'custom-print-installed-p #[nil "KK=" [custom-prin1 prin1] 2 (#$ . 4847)]) (byte-code "##\"" [put with-custom-print-funcs edebug-form-spec (body) with-custom-print (body) defalias] 4) #@68 Temporarily install the custom print package while executing BODY. (defalias 'with-custom-print '(macro . #[(&rest body) " BBBB" [unwind-protect progn (custom-print-install) body ((custom-print-uninstall))] 4 (#$ . 5128)])) #@410 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). This is the custom-print replacement for the standard `prin1'. It uses the appropriate printer depending on the values of `print-level' and `print-circle' (which see). (defalias 'custom-prin1 #[(object &optional stream) " \n#" [cust-print-top-level object stream cust-print-original-prin1] 4 (#$ . 5364)]) #@285 Output the printed representation of OBJECT, any Lisp object. No quoting characters are used; no delimiters are printed around the contents of strings. Output stream is STREAM, or value of `standard-output' (which see). This is the custom-print replacement for the standard `princ'. (defalias 'custom-princ #[(object &optional stream) " \n#" [cust-print-top-level object stream cust-print-original-princ] 4 (#$ . 5921)]) #@264 Return a string containing the printed representation of OBJECT, any Lisp object. Quoting characters are used when needed to make output that `read' can handle, whenever this is possible. This is the custom-print replacement for the standard `prin1-to-string'. (defalias 'custom-prin1-to-string #[(object) "!\nq ) \n\"\nq *" [get-buffer-create " *custom-print-temp*" buf erase-buffer custom-prin1 object buffer-string] 3 (#$ . 6353)]) #@312 Output the printed representation of OBJECT, with newlines around it. 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). This is the custom-print replacement for the standard `print'. (defalias 'custom-print #[(object &optional stream) "\n\"\f\n\"\n\"" [cust-print-original-princ "\n" stream custom-prin1 object] 3 (#$ . 6810)]) #@850 Format a string out of a control-string and arguments. The first argument is a control string. It, and subsequent arguments substituted into it, become the value, which is a string. It may contain %s or %d or %c to substitute successive following arguments. %s means print an argument as a string, %d means print as number in decimal, %c means print a number as a single character. The argument used by %s must be a string or a symbol; the argument used by %d, %b, %o, %x or %c must be a number. This is the custom-print replacement for the standard `format'. It calls the emacs `format' after first making strings for list, vector, or symbol 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-format #[(fmt &rest args) "\n \"#" [apply cust-print-original-format fmt mapcar #[(arg) "<!9!" [arg vectorp custom-prin1-to-string] 2] args] 6 (#$ . 7281)]) #@495 Print a one-line message at the bottom of the screen. The first argument is a control string. It may contain %s or %d or %c to print successive following arguments. %s means print an argument as a string, %d means print as number in decimal, %c means print a number as a single character. The argument used by %s must be a string or a symbol; the argument used by %d or %c must be a number. This is the custom-print replacement for the standard `message'. See `custom-format' for the details. (defalias 'custom-message #[(fmt &rest args) "\n \"#" [apply cust-print-original-message fmt mapcar #[(arg) "<!9!" [arg vectorp custom-prin1-to-string] 2] args] 6 (#$ . 8335)]) #@173 Signal an error, making error message by passing all args to `format'. This is the custom-print replacement for the standard `error'. See `custom-format' for the details. (defalias 'custom-error #[(fmt &rest args) "\f #C\"" [signal error apply custom-format fmt args] 6 (#$ . 9036)]) (byte-code " B B" [circle-table current-load-list cust-print-current-level] 2) (defalias 'cust-print-original-printer #[(object) "" [nil] 1]) (defalias 'cust-print-low-level-prin #[(object) "" [nil] 1]) (defalias 'cust-print-prin #[(object) "" [nil] 1]) (defalias 'cust-print-top-level #[(object stream emacs-printer) " \n\f\f!  \" :: :> :>Ђ?\"L҂M\"\f!\f+" [stream standard-output print-circle cust-print-preprocess-circle-tree object print-level -1 cust-print-current-level circle-table defalias cust-print-original-printer emacs-printer cust-print-low-level-prin custom-printers custom-print-vectors print-length cust-print-print-object cust-print-prin cust-print-print-circular] 3]) (defalias 'cust-print-print-object #[(object) "!!:!!#!!" [object cust-print-original-printer cust-print-use-custom-printer cust-print-list vectorp cust-print-vector] 2]) (defalias 'cust-print-print-circular #[(object) " 8\nAV! !!4\n [! [!!!);!)" [object circle-table tag id 0 cust-print-original-princ "#" "=" cust-print-low-level-prin] 3]) (defalias 'cust-print-list #[(list) "U !S! @!A.!SxUx<[\n[@!Ag!!S3!3U!!*" [cust-print-current-level 0 cust-print-original-princ "#" "(" print-length length cust-print-prin list " " circle-table ". " nil "..." ")"] 3]) (defalias 'cust-print-vector #[(vector) "U !VS\fG!$ ^ WE\fH!T\fGW$!$\fGWQ!!+\f" [cust-print-current-level 0 cust-print-original-princ "#" vector len i "[" print-length cust-print-prin " " "..." "]"] 4]) (defalias 'cust-print-preprocess-circle-tree #[(object) "C ! A A>A@A3 SA:AA)* A)" [nil circle-table cust-print-walk-circle-tree object -1 id rest tag] 3]) (defalias 'cust-print-walk-circle-tree #[(object) "  9 !!=?$ A0 ǡ>\n> CAB F{ :U @! A{ !{ G \f \fWz  H! T d**" [nil tag read-equivalent-p object intern-soft symbol-name circle-table t cust-print-walk-circle-tree vectorp 0 j i] 5]) (provide (quote cust-print))