def-char-to-octets-macro

Macro

Package: excl

Arguments: name arglist &body body

name should be a symbol. arglist should be a macro lambda list with two required arguments and two specified keyword arguments :put-next-octet, and :external-format. (You may choose your own names for the required arguments, of course. The arglist argument is present mostly to make this macro similar in form to defmacro.) body should be a list of forms.

This macro is just like defmacro except that name names an external-format, and the actual macro name (a gensym) for the macro being defined is stored in the external-format's chars-to-octets-macro slot. Also, if no external-format with name name exists, then a new external-format with name name is created.

The macro being defined must accept two required arguments, which we will call char, and state-loc (but you can, of course, call anything) and two keyword argument which must be called put-next-octet and external-format. (The external-format argument is only used if name names an external-format that is a wrapper (ie, a composing external-format)).

When the macro actually being defined is called, the char will be a character to convert, and the state-loc will be a setf-able locative (similar to the first argument to setf) that can be used by the convertor to hold state information.

The put-next-octet argument to the macro being defined is a single-argument expression that is invoked in the macro's expansion at the point or points where the translation procedure requests that the next translated external-element (eg, octet) be output.

If the external-format named by name is a composing external-format, then the external-format argument to the macro being defined is the name of the external-format being wrapped.

Examples:

;; Defines a chars -> octets procedure for latin1 characters.
;;
(def-char-to-octets-macro :latin1-base (char
                                        state-loc
                                        &key put-next-octet external-format)
  (declare (ignore external-format state-loc))
  (let ((code-var (gensym))
        (char-var (gensym)))
    `(let ((,char-var ,char))
       (let ((,code-var (char-int ,char-var)))
         (,put-next-octet ,code-var)))))


;; Defines a chars -> octets procedure for utf-8 characters.
;;
(def-char-to-octets-macro :utf8-base (char
                                      state
                                      &key put-next-octet external-format)
  (declare (ignore external-format state))
  (let ((code-var (gensym)))
    `(let ((,code-var (char-code ,char)))
       (if* (< ,code-var #x7f)
          thenret ;; ascii
        elseif (< ,code-var #x7ff)
          then (,put-next-octet (logior #xc0 (ash ,code-var -6)))
               (setq ,code-var (logior #x80 (logand ,code-var #x3f)))
          else (,put-next-octet (logior #xe0 (ash ,code-var -12)))
               (,put-next-octet (logior #x80 (logand (ash ,code-var -6)
                                                     #x3f)))
               (setq ,code-var (logior #x80 (logand ,code-var #x3f))))
       (,put-next-octet ,code-var))))


;; Defines a composing external format that splits up #\newline into
;; #\return #\linefeed.
;;
(def-char-to-octets-macro :crlf (char
                                 state
                                 &key put-next-octet external-format)
  (declare (ignorable state))
  (let ((char-var (gensym)))
    `(let ((,char-var ,char))
       (when (eq #\newline ,char-var)
         (char-to-octets ,external-format #\return ,state
                         :put-next-octet ,put-next-octet)
         (setq ,char-var #\linefeed))
       (char-to-octets ,external-format ,char-var ,state
                       :put-next-octet ,put-next-octet))))

;; The following uses the above defined wrapper external-format to
;; create a latin1 convertor with #\newline mapped to octets for
;; ASCII Carriage-Return and Linefeed.
;;
;; Note: Using (compose-external-formats :crlf :latin1-base) achieves as one
;; of its side-effects the same effect as evaluating the following:
;;
(def-char-to-octets-macro :crlf-latin1-base (char state
                                             &key put-next-octet
                                                  external-format)
  (declare (ignore external-format))
  `(char-to-octets :crlf ,char ,state
                   :put-next-octet ,put-next-octet
                   :external-format :latin1-base))