cl:format

说明：common lisp 中功能强大的格式化输出字符串函数。

用法：

 (cl:format stream ctrl-string variables)

参数：1 stream : 字符串;2 ctrl-string : 未识别定义;3 variables : 未识别定义;

返回值：String

示例：

(cl:format "~{~a ~}" (list '("a""b""c")))

(defun cl:format (stream ctrl-string variables / flag-instruct flag-comma number1 number2 result to-string tmp-str init-flag)
  "common lisp 中 功能强大的格式化输出字符串函数。"
  "String"
  "(cl:format \"~{~a ~}\"
    (list '(\"a\"\"b\"\"c\")))"
  (defun to-string (para)
    (cond ((= (quote int)
          (type-of para))
        (itoa para))
      ((= (quote real)
          (type-of para))
        (rtos para 2 3))
      ((= (quote str)
          (type-of para))
        para)
      ((= (quote list)
          (type-of para))
        (vl-prin1-to-string para))
      ((= (quote sym)
          (type-of para))
        (vl-symbol-name para))))
  (defun init-flag nil (setq flag-instruct nil flag-comma nil number1 ""
      number2 ""))
  (init-flag)
  (setq result "")
  (while (/= ""
      ctrl-string)
    (if flag-instruct (cond ((= (ascii ",")
            (ascii ctrl-string))
          (setq flag-comma t))
        ((= (ascii "v")
            (ascii ctrl-string))
          (setq number1 (to-string (car variables)))
          (setq variables (cdr variables)))
        ((= (ascii "#")
            (ascii ctrl-string))
          (setq number1 (to-string (length variables)))
          (setq variables (cdr variables)))
        ((and (> (ascii ctrl-string)
              47)
            (> 58 (ascii ctrl-string)))
          (if flag-comma (setq number2 (strcat number2 (substr ctrl-string 1 1)))
            (setq number1 (strcat number1 (substr ctrl-string 1 1)))))
        ((= (ascii "~")
            (ascii ctrl-string))
          (setq result (strcat result "~"))
          (init-flag))
        ((= (ascii "%")
            (ascii ctrl-string))
          (setq result (strcat result "\n"))
          (init-flag))
        ((= (ascii "&")
            (ascii ctrl-string))
          (setq result (strcat result "\n"))
          (init-flag))
        ((= (ascii "A")
            (ascii (strcase (substr ctrl-string 1 1))))
          (setq result (strcat result (to-string (car variables))))
          (setq variables (cdr variables))
          (init-flag))
        ((= (ascii "S")
            (ascii (strcase (substr ctrl-string 1 1))))
          (setq result (strcat result (vl-prin1-to-string (car variables))))
          (setq variables (cdr variables))
          (init-flag))
        ((= (ascii "D")
            (ascii (strcase (substr ctrl-string 1 1))))
          (if (/= ""
              number1)
            (progn (setq tmp-str (to-string (car variables)))
              (if (> (atoi number1)
                  (strlen tmp-str))
                (repeat (- (atoi number1)
                    (strlen tmp-str))
                  (setq result (strcat result "
                      "))))
              (setq tmp-str "")))
          (setq result (strcat result (to-string (fix (car variables)))))
          (setq variables (cdr variables))
          (init-flag))
        ((= (ascii "B")
            (ascii (strcase (substr ctrl-string 1 1))))
          (if (/= ""
              number1)
            (progn (setq tmp-str (to-string (car variables)))
              (if (> (atoi number1)
                  (strlen tmp-str))
                (repeat (- (atoi number1)
                    (strlen tmp-str))
                  (setq result (strcat result "
                      "))))
              (setq tmp-str "")))
          (setq result (strcat result (m:dec->base (fix (car variables))
                2)))
          (setq variables (cdr variables))
          (init-flag))
        ((= (ascii "O")
            (ascii (strcase (substr ctrl-string 1 1))))
          (if (/= ""
              number1)
            (progn (setq tmp-str (to-string (car variables)))
              (if (> (atoi number1)
                  (strlen tmp-str))
                (repeat (- (atoi number1)
                    (strlen tmp-str))
                  (setq result (strcat result "
                      "))))
              (setq tmp-str "")))
          (setq result (strcat result (m:dec->base (fix (car variables))
                8)))
          (setq variables (cdr variables))
          (init-flag))
        ((= (ascii "X")
            (ascii (strcase (substr ctrl-string 1 1))))
          (if (/= ""
              number1)
            (progn (setq tmp-str (to-string (car variables)))
              (if (> (atoi number1)
                  (strlen tmp-str))
                (repeat (- (atoi number1)
                    (strlen tmp-str))
                  (setq result (strcat result "
                      "))))
              (setq tmp-str "")))
          (setq result (strcat result (m:dec->base (fix (car variables))
                16)))
          (setq variables (cdr variables))
          (init-flag))
        ((= (ascii "F")
            (ascii (strcase (substr ctrl-string 1 1))))
          (if (= ""
              number2)
            (setq tmp-str (rtos (car variables)
                2 3))
            (setq tmp-str (rtos (car variables)
                2 (atoi number2))))
          (if (/= ""
              number1)
            (progn (if (> (atoi number1)
                  (strlen tmp-str))
                (repeat (- (atoi number1)
                    (strlen tmp-str))
                  (setq result (strcat result "
                      "))))))
          (setq result (strcat result tmp-str))
          (setq tmp-str "")
          (setq variables (cdr variables))
          (init-flag))
        ((= (ascii "E")
            (ascii (strcase (substr ctrl-string 1 1))))
          (if (= ""
              number2)
            (setq tmp-str (rtos (car variables)
                1 3))
            (setq tmp-str (rtos (car variables)
                1 (atoi number2))))
          (if (/= ""
              number1)
            (progn (if (> (atoi number1)
                  (strlen tmp-str))
                (repeat (- (atoi number1)
                    (strlen tmp-str))
                  (setq result (strcat result "
                      "))))))
          (setq result (strcat result tmp-str))
          (setq tmp-str "")
          (setq variables (cdr variables))
          (init-flag))
        ((= (ascii "$")
            (ascii (strcase (substr ctrl-string 1 1))))
          (if (= ""
              number1)
            (setq result (strcat result (rtos (car variables)
                  2 2)))
            (setq result (strcat result (rtos (car variables)
                  2 (atoi number1)))))
          (setq variables (cdr variables))
          (init-flag))
        ((= (ascii "{")
            (ascii (strcase (substr ctrl-string 1 1))))
          (setq ctrl-string (substr ctrl-string 2))
          (setq sub-ctrl-string "")
          (while (and (<= 2 (strlen ctrl-string))
              (/= "~}"
                (substr ctrl-string 1 2)))
            (setq sub-ctrl-string (strcat sub-ctrl-string (substr ctrl-string 1 1)))
            (setq ctrl-string (substr ctrl-string 2)))
          (setq ctrl-string (substr ctrl-string 3))
          (foreach para (car variables)
            (if (atom para)
              (setq para (list para)))
            (setq result (strcat result (cl:format nil sub-ctrl-string para))))
          (setq variables (cdr variables))
          (init-flag))
        ((= (ascii "[")
            (ascii (strcase (substr ctrl-string 1 1))))
          (setq ctrl-string (substr ctrl-string 2))
          (setq sub-ctrl-string "")
          (while (and (<= 2 (strlen ctrl-string))
              (/= "~]"
                (substr ctrl-string 1 2)))
            (setq sub-ctrl-string (strcat sub-ctrl-string (substr ctrl-string 1 1)))
            (setq ctrl-string (substr ctrl-string 2)))
          (setq ctrl-string (substr ctrl-string 3))
          (setq sub-lst (string:parse-by-lst sub-ctrl-string (quote ("~;"
                  "~:;"))))
          (cond ((< (car variables)
                (length sub-lst))
              (setq result (strcat result (nth (car variables)
                    sub-lst))))
            (t (if (vl-string-search "`~:;"
                  sub-ctrl-string)
                (setq result (strcat result (last sub-lst))))))
          (setq variables (cdr variables))
          (init-flag)))
      (cond ((= (ascii "~")
            (ascii ctrl-string))
          (setq flag-instruct t))
        (t (setq result (strcat result (substr ctrl-string 1 1))))))
    (setq ctrl-string (substr ctrl-string 2)))
  (cond ((= t stream)
      (princ result)
      (princ))
    ((= nil stream)
      result)
    ((= (type stream)
        (quote file))
      (write-line result stream))))

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

cl:format

上传记录