@lisp Editor string:auto-split

用法

建议

(defun string:auto-split (str / curr-type lst tmp% res unitp)
  "自动分段，按数字-字母-汉字自动断开字符串为字符串列表。不支持科学计数法的数字。"
  "由字符串组成的列表"
  "(string:auto-split \"aa33.3bb汉字\")"
  (defun is-bracket (asc)
    (member asc (vl-string->list "()")))
  (defun is-operator (asc)
    (member asc (vl-string->list "+-*/·")))
  (defun is-unitsuffix (asc)
    (member asc (vl-string->list "\U+00B2\U+00B3")))
  (defun is-unitprefix (asc)
    (member asc (vl-string->list "\U+00B5")))
  (defun is-number (asc)
    (or (= asc 46)
      (and (>= asc 48)
        (<= asc 57))))
  (defun is-alpha (asc)
    (or (and (>= asc 65)
        (<= asc 90))
      (and (>= asc 97)
        (<= asc 122))))
  (defun is-hannum (asc)
    (member asc (string:s2l-ansi "零一二三四五六七六九十百千万亿")))
  (defun is-han (asc)
    (if (and (getvar "lispsys")
        (> (getvar "lispsys")
          0))
      (>= asc 19968)
      (>= asc 32896)))
  (defun is-sign (asc)
    (or (= asc (ascii "+"))
      (= asc (ascii "-"))))
  (defun test-type (asc)
    (cond ((is-number asc)
        (quote number))
      ((is-alpha asc)
        (quote alpha))
      ((is-hannum asc)
        (quote hannumber))
      ((is-han asc)
        (quote han))
      ((is-sign asc)
        (quote sign))
      ((is-bracket asc)
        (quote bracket))
      ((is-operator asc)
        (quote operator))
      ((is-unitsuffix asc)
        (quote unitsuffix))
      ((is-unitprefix asc)
        (quote unitprefix))
      (t nil)))
  (setq res (mapcar (quote (lambda (x)
          (cons x (test-type x))))
      (string:s2l-ansi str)))
  (setq curr-type (cdr (car res)))
  (setq lst (quote nil))
  (foreach asc res (cond ((or (= curr-type (cdr asc))
          (and (= curr-type (quote sign))
            (= (cdr asc)
              (quote number))))
        (setq tmp% (cons (car asc)
            tmp%)))
      (t (progn (setq lst (cons (reverse tmp%)
              lst))
          (setq tmp% (cons (car asc)
              nil))
          (setq curr-type (cdr asc))))))
  (setq lst (reverse (cons (reverse tmp%)
        lst)))
  (setq res (mapcar (quote string:l2s-ansi)
      lst))
  (setq unitp (member (car res)
      @:*units*))
  (setq lst (quote nil))
  (setq tmp% "")
  (foreach word res (cond ((and unitp (member word @:*units*))
        (setq tmp% (strcat tmp% word)))
      (t (progn (setq lst (cons tmp% lst))
          (setq tmp% word)
          (setq unitp (member word @:*units*))))))
  (setq lst (reverse (cons tmp% lst))))

统计信息

上传记录

统计信息

上传记录 刷新

上传记录