From: Simon Katz
Subject: Half of *PRINT-ESCAPE*
Date: 
Message-ID: <b01ja6$kc8me$1@ID-131024.news.dfncis.de>
I want to get half the effect of binding *PRINT-ESCAPE* to False.
When *PRINT-ESCAPE* is False, neither escape characters nor
package prefixes are output when an expression is printed. But is
there a way to have package prefixes printed (when necessary) and
escape characters not printed?

The only idea I have is to write a function that takes a symbol
as parameter, and returns a string of the form
    "bar"
 or ":bar"
 or "foo:bar"
 or "foo::bar"
 or "#:bar"
depending on the symbol, whether it is accessible from the
current package, etc. (BTW, I don't know how best to go about
writing this function.)

Using such a function I could print individual symbols the way I
want, but AFAIK there's no way to arrange for the function to be
used whenever the Lisp printer prints a symbol.

Perhaps I'm missing something really simple...

From: Barry Margolin
Subject: Re: Half of *PRINT-ESCAPE*
Date: 
Message-ID: <kqYU9.25$Lf6.717@paloalto-snr1.gtei.net>
In article <··············@ID-131024.news.dfncis.de>,
Simon Katz <·····@nomistech.com> wrote:
>I want to get half the effect of binding *PRINT-ESCAPE* to False.
>When *PRINT-ESCAPE* is False, neither escape characters nor
>package prefixes are output when an expression is printed. But is
>there a way to have package prefixes printed (when necessary) and
>escape characters not printed?
...
>Perhaps I'm missing something really simple...

No.  I don't think we anticipated that this would be a useful format.

-- 
Barry Margolin, ······@genuity.net
Genuity, Woburn, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.
Please DON'T copy followups to me -- I'll assume it wasn't posted to the group.
From: Steven M. Haflich
Subject: Re: Half of *PRINT-ESCAPE*
Date: 
Message-ID: <3E246A34.5010208@alum.mit.edu>
Barry Margolin wrote:
> In article <··············@ID-131024.news.dfncis.de>,
> Simon Katz <·····@nomistech.com> wrote:
> 
>>I want to get half the effect of binding *PRINT-ESCAPE* to False.
>>When *PRINT-ESCAPE* is False, neither escape characters nor
>>package prefixes are output when an expression is printed. But is
>>there a way to have package prefixes printed (when necessary) and
>>escape characters not printed?
> 
> ...
> 
>>Perhaps I'm missing something really simple...
> 
> 
> No.  I don't think we anticipated that this would be a useful format.

Yes.  Use the pretty printer and define a pretty-print-dispatch for
symbol that does what you want.  It isn't completely trivial because
you'll want to handle keywords and nil idiosyncratically, but you can
probably get what you want.

Remember that what you print won't be rereadable, or even syntactic,
without escape characters.  Consider a symbol that has whitespace or
parens or quotes in its symbol-name.
From: Simon Katz
Subject: Re: Half of *PRINT-ESCAPE*
Date: 
Message-ID: <b04203$kuhmu$1@ID-131024.news.dfncis.de>
"Steven M. Haflich" <·················@alum.mit.edu> wrote in
message ·····················@alum.mit.edu...
> > In article <··············@ID-131024.news.dfncis.de>,
> > Simon Katz <·····@nomistech.com> wrote:
> >
> >>I want to get half the effect of binding *PRINT-ESCAPE* to
> >>False.
> >>When *PRINT-ESCAPE* is False, neither escape characters nor
> >>package prefixes are output when an expression is printed.
> >>But is
> >>there a way to have package prefixes printed (when necessary)
> >>and
> >>escape characters not printed?
> >
> > ...
> >
> >>Perhaps I'm missing something really simple...
>
> Yes.  Use the pretty printer and define a pretty-print-dispatch
> for symbol that does what you want.  It isn't completely
> trivial because you'll want to handle keywords and nil
> idiosyncratically, but you can probably get what you want.
>
> Remember that what you print won't be rereadable, or even
> syntactic, without escape characters.  Consider a symbol that
> has whitespace or parens or quotes in its symbol-name.

Thanks.

In case anyone is interested in the details or would like to
comment, see my code below. I'm using COPY-PPRINT-DISPATCH,
SET-PPRINT-DISPATCH, and dynamic binding of
*PRINT-PPRINT-DISPATCH*.

I'm unhappy with the inefficiency of PACKAGE-EXTERNAL-SYMBOLS,
PACKAGE-ACCESSIBLE-SYMBOLS and SYMBOL-ACCESSIBLE, all of which
execute loops every time they are called. In particular, is there
a more direct way of implementing SYMBOL-ACCESSIBLE?

In a separate reply:
> From: "Erik Naggum" <····@naggum.no>
> Sent: Tuesday, January 14, 2003 8:00 PM
> * Simon Katz
> | I want to get half the effect of binding *PRINT-ESCAPE* to
> | False.
> | When *PRINT-ESCAPE* is False, neither escape characters
> | nor package
> | prefixes are output when an expression is printed. But is
> | there a
> | way to have package prefixes printed (when necessary) and
> | escape
> | characters not printed?
>
>   Which escape characters do you not want to see printed?

I have some symbols that start with a #, and, for example, I want
to print the symbol named "#-APPLES" as #-APPLES rather than
\#-APPLES. I want to do this because I want to print some code in
a form that is easy for non-Lispers to read. I *think* it makes
sense.


My code:

___________________________________________________________

(defun package-external-symbols (package)
  (let* ((acc '()))
    (do-external-symbols (sym package)
      (push sym acc))
    acc))

(defun package-accessible-symbols (package)
  (let* ((acc '()))
    (do-symbols (sym package)
      (push sym acc))
    acc))

(defun symbol-accessible (symbol &optional (package *package*))
  "True iff SYMBOL is accessible from PACKAGE."
  (member symbol (package-accessible-symbols package)))

(defparameter *my-print-pprint-dispatch* (copy-pprint-dispatch))

(set-pprint-dispatch
 'symbol
 #'(lambda (stream symbol)
     (assert (not *print-readably*))
     (let* ((fun (ecase *print-case*
                   (:upcase #'string-upcase)
                   (:downcase #'string-downcase)
                   (:capitalize #'string-capitalize)))
            (package (symbol-package symbol)))
       (if package
           (let* ((package-prefix-p
                   (if *print-escape*
                       (and (not (keywordp symbol))
                            (not (symbol-accessible symbol)))
                     nil))
                  (n-colons
                   (if *print-escape*
                       (cond ((keywordp symbol) 1)
                             ((not package-prefix-p)  0)
                             ((member symbol
                                      (package-external-symbols
                                       package))
                              1)
                             (t 2))
                     0)))
             (let* ((*print-escape* nil))
               (when package-prefix-p
                 (write (funcall fun (package-name package))
                        :stream stream))
               (ecase n-colons
                 (0 #| do nothing |#)
                 (1 (write #\: :stream stream))
                 (2 (write "::" :stream stream)))
               (write (funcall fun (symbol-name symbol))
                      :stream stream)))
         ;; SYMBOL is apparently uninterned
         (let* ((*print-escape* nil))
           (write "#:" :stream stream)
           (write (funcall fun (symbol-name symbol))
                  :stream stream)))))
 0
 *my-print-pprint-dispatch*)

#|
(defpackage "FOO"
  (:export "GOO" "#-FROGS" "GOOzHOO"))

(let* ((*print-pretty* t)
       (*print-case* :downcase)
       (*print-pprint-dispatch* *my-print-pprint-dispatch*))
  (list
   (prin1-to-string 'fred)
   (prin1-to-string '\#-apples)
   (prin1-to-string 'foo:\#-frogs)
   (prin1-to-string 'foo:goo\zhoo)
   (prin1-to-string 'foo::unexported-symbol)))
=> ("fred" "#-apples" "foo:#-frogs" "foo:goozhoo"
"foo::unexported-symbol")
|#
From: Simon Katz
Subject: Re: Half of *PRINT-ESCAPE*
Date: 
Message-ID: <b042or$lfsma$1@ID-131024.news.dfncis.de>
I wrote:
> I'm unhappy with the inefficiency of PACKAGE-EXTERNAL-SYMBOLS,
> PACKAGE-ACCESSIBLE-SYMBOLS and SYMBOL-ACCESSIBLE, all of which
> execute loops every time they are called. In particular, is
> there a more direct way of implementing SYMBOL-ACCESSIBLE?

I'm not sure why I wrote that last sentence. Please ignore it.

Also, I don't know why I didn't have a separate function like
this to mirror SYMBOL-ACCESSIBLE:

(defun symbol-exported (symbol)
  ;; UNTESTED
  (let* ((package (symbol-package symbol)))
    (if package
        (member symbol (package-external-symbols package))
       nil)))
From: Steven M. Haflich
Subject: Re: Half of *PRINT-ESCAPE*
Date: 
Message-ID: <3E26246B.1030907@alum.mit.edu>
Simon Katz wrote:

> (defun symbol-exported (symbol)
>   ;; UNTESTED
>   (let* ((package (symbol-package symbol)))
>     (if package
>         (member symbol (package-external-symbols package))
>        nil)))

You previously mentioned that you were concerned about
efficiency of this fnuction.  I half suspect that this
concern is misdirected, but regardless, member is an O^n
function, and package-external-symbols may need to construct
its list of symbols.  Not cheap.

You would likely get much better performance using find-symbol
or intern, since these important functions are likely already
well optimized by the implementation (by using hashing, etc. etc.)

(defun symbol-exported-from-home-package-p (symbol)
   (let ((package (symbol-package symbol)))
     (and package
	 (multiple-value-bind (sym status)
	     (find-symbol (symbol-name symbol) package)
	   (and (eq sym symbol)		; for safety in weird situations
		(eq status :external))))))

This will likley run a lot faster in any plausible implementation.
From: Simon Katz
Subject: Re: Half of *PRINT-ESCAPE*
Date: 
Message-ID: <b04k0p$lsf6p$1@ID-131024.news.dfncis.de>
I wrote in message
···················@ID-131024.news.dfncis.de...
> I'm unhappy with the inefficiency of PACKAGE-EXTERNAL-SYMBOLS,
> PACKAGE-ACCESSIBLE-SYMBOLS and SYMBOL-ACCESSIBLE, all of which
> execute loops every time they are called. In particular, is
> there a more direct way of implementing SYMBOL-ACCESSIBLE?

I've had a private email telling me how to do things properly
using FIND-SYMBOL.

In case anyone is interested, here's my revised code:
_________________________________________________________

(defun symbol-accessible-p (symbol &optional (package *package*))
  (eq (find-symbol (symbol-name symbol) package)
      symbol))

(defun symbol-internal-p (symbol)
  (let* ((package (symbol-package symbol)))
    (assert (not (null package))
        nil
      "~S is apparently uninterned."
      symbol)
    (eq (nth-value 1 (find-symbol (symbol-name symbol) package))
        :internal)))

(defparameter *my-print-pprint-dispatch* (copy-pprint-dispatch))

(defun symbol-package-prefix (symbol)
  (let* ((package (symbol-package symbol)))
    (cond ((null package) "#:")
          ((string= (package-name package) "KEYWORD") ":")
          ((symbol-accessible-p symbol) "")
          ((symbol-internal-p symbol)
           (concatenate 'string (package-name package) "::"))
          (t
           (concatenate 'string (package-name package) ":")))))

(set-pprint-dispatch
 'symbol
 #'(lambda (stream symbol)
     (assert (not *print-readably*))
     (let* ((package-prefix (if *print-escape*
                                (symbol-package-prefix symbol)
                              ""))
            (case-fun (ecase *print-case*
                        (:upcase #'string-upcase)
                        (:downcase #'string-downcase)
                        (:capitalize #'string-capitalize))))
       (format stream "~A~A"
               (funcall case-fun package-prefix)
               (funcall case-fun (symbol-name symbol)))))
 0
 *my-print-pprint-dispatch*)

#|
(defpackage "FOO"
  (:export "GOO" "#-FROGS" "GOOzHOO"))

(let* ((*print-pretty* t)
       (*print-case* :downcase)
       (*print-pprint-dispatch* *my-print-pprint-dispatch*))
  (list
   (prin1-to-string 'fred)
   (prin1-to-string '\#-apples)
   (prin1-to-string 'foo:\#-frogs)
   (prin1-to-string 'foo:goo\zhoo)
   (prin1-to-string 'foo::unexported-symbol)))
=> ("fred" "#-apples" "foo:#-frogs" "foo:goozhoo"
    "foo::unexported-symbol")
|#
From: Erik Naggum
Subject: Re: Half of *PRINT-ESCAPE*
Date: 
Message-ID: <3251563232194534@naggum.no>
* Simon Katz
| I want to get half the effect of binding *PRINT-ESCAPE* to False.
| When *PRINT-ESCAPE* is False, neither escape characters nor package
| prefixes are output when an expression is printed. But is there a
| way to have package prefixes printed (when necessary) and escape
| characters not printed?

  Which escape characters do you not want to see printed?

  Going on a hunch here that you have mixed-case symbol names, perhaps
  your problem is solved by tweaking the `readtable-case�, instead?

(setf *readtable* (copy-readtable))
(setf (readtable-case *readtable*) :preserve)
  
-- 
Erik Naggum, Oslo, Norway

Act from reason, and failure makes you rethink and study harder.
Act from faith, and failure makes you blame someone and push harder.