用法
评论
建议
取 消
确 定
(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))))
函数库使用说明
应用包
技术支持
统计信息
函数库规模: 733 个
函数库类别: 51 种
上传记录
刷新
冀公网安备 13050302000400号