#xyzzy 簡易パーサ(主にC/C++の関数宣言用)

gistfile1.cl

(defvar *items*)
(defvar *item-buffer*)

(defun push-item ()
  (unless (string= "" *item-buffer*)
    (push (copy-seq *item-buffer*) *items*)
    (setf (fill-pointer *item-buffer*) 0)))

(defun init ()
  (setf *items* nil)
  (setf *item-buffer* (make-vector 0 :element-type 'character :fill-pointer 0 :adjustable t)))

(defun feed (stream)
  (init)
  (let ((f 'parse-main))
    (while (peek-char nil stream nil nil)
      (setf f (funcall f stream)))
    (push-item))
  (nreverse *items*))

(defun parse-main (stream)
  (let ((c (read-char stream)))
    (case c
      ((#\SPC #\TAB #\LFD)
       (push-item)
       'parse-main)
      ((#\")
       (push-item)
       (vector-push-extend c *item-buffer*)
       'parse-quote)
      ((#\/)
       (push-item)
       (vector-push-extend c *item-buffer*)
       'parse-slash)
      ((#\()
       (push-item)
       (vector-push-extend c *item-buffer*)
       'parse-left-paren)
      ((#\<)
       (vector-push-extend c *item-buffer*)
       'parse-greater-than)
      ((#\, #\* #\&)
       (push-item)
       (push c *items*)
       'parse-main)
      (t
       (vector-push-extend c *item-buffer*)
       'parse-main))))

(defun parse-quote (stream)
  (let ((c (read-char stream)))
    (case c
      ((#\")
       (vector-push-extend c *item-buffer*)
       (push-item)
       'parse-main)
      ((#\\)
       'parse-quote-bs))))

(defun parse-quote-bs (stream)
  (let ((c (read-char stream)))
    (vector-push-extend c *item-buffer*)
    'parse-quote))

(defun parse-slash (stream)
  (let ((c (read-char stream)))
    (case c
      ((#\/)
       (vector-push-extend c *item-buffer*)
       'read-line-comment)
      ((#\*)
       (vector-push-extend c *item-buffer*)
       'parse-multi-comment)
      (t
       (vector-push-extend c *item-buffer*)
       'parse-main))))

(defun read-line-comment (stream)
  (let ((c (read-char stream)))
    (case c
      ((#\LFD)
       ;; (push (copy-seq *item-buffer*) *items*)
       (setf (fill-pointer *item-buffer*) 0)
       'parse-main)
      (t
       (vector-push-extend c *item-buffer*)
       'read-line-comment))))

(defun parse-multi-comment (stream)
  (let ((c (read-char stream)))
    (case c
      ((#\*)
       (vector-push-extend c *item-buffer*)
       'parse-multi-comment-star)
      (t
       (vector-push-extend c *item-buffer*)
       'parse-multi-comment))))

(defun parse-multi-comment-star (stream)
  (let ((c (read-char stream)))
    (case c
      ((#\/)
       (vector-push-extend c *item-buffer*)
       ;; (push (copy-seq *item-buffer*) *items*)
       (setf (fill-pointer *item-buffer*) 0)
       'parse-main)
      ((#\*)
       (vector-push-extend c *item-buffer*)
       'parse-multi-comment-star)
      (t
       (vector-push-extend c *item-buffer*)
       'parse-multi-comment))))

(defun parse-left-paren (stream)
  (let ((c (read-char stream)))
    (case c
      ((#\))
       (vector-push-extend c *item-buffer*)
       (push (let ((text (substring *item-buffer* 1 -1))
                   (*item-buffer* nil)
                   (*items* nil))
               (with-input-from-string (in text)
                 (feed in)))
             *items*)
       (setf (fill-pointer *item-buffer*) 0)
       'parse-main)
      (t
       (vector-push-extend c *item-buffer*)
       'parse-left-paren))))

(defun parse-greater-than (stream)
  (let ((c (read-char stream)))
    (case c
      ((#\>)
       (vector-push-extend c *item-buffer*)
       (push-item)
       'parse-main)
      (t
       (vector-push-extend c *item-buffer*)
       'parse-greater-than))))
;;;

(defun function-name (tree)
  (do* ((f tree s)
        (s (cdr tree) (cdr s)))
      ((listp (car s)) (car f))))

(defun function-name (tree)
  (let ((name nil))
    (dolist (i tree)
      (when (listp i)
        (return name))
      (setf name i))))

(defun function-return-type (tree)
  (let ((type '()))
    (dolist (i tree)
      (when (listp i)
        (return (nreverse (cdr type))))
      (push i type))))

(defun function-args (tree)
  (let ((buf nil) (args '()))
    (dolist (i (find-if #'listp tree))
      (cond ((eql #\, i)
             (push (nreverse buf) args)
             (setf buf nil))
            (t
             (push i buf))))
    (when buf (push (nreverse buf) args))
    (nreverse args)))

(defun insert-function-comment ()
  (interactive)
  (with-input-from-string (in (buffer-substring (save-excursion (scan-buffer "[{};]\\|^$" :regexp t :reverse t :tail t) (point))
                                                (save-excursion (scan-buffer "[{};]\\|^$" :regexp t) (point))))
    (let ((parsed (feed in)))
      (goto-bol)
      (while (looking-at "[0-9A-Za-z_*<>&:]") (forward-line -1))
      (insert "\n////////////////////////////////////////////////////////////////\n")
      (insert "/// \n")
      (mapcar (lambda (x) #+nil (msgbox "~S" x) (insert (format nil "/// @param ~A ~%" (car (last x))))) (function-args parsed))
      #+nil (msgbox "~S" (function-return-type parsed))
      (when (and (function-return-type parsed)
                 (not (equal '("void") (function-return-type parsed))))
        (insert "/// @return \n")))))

#|
(with-input-from-string (in "void
SikosApplication::setManualMeasure(int index)")
(feed in))
(with-input-from-string (in "bool
SikosApplication::readMeasuredParts(const QString& file)")
(feed in))
(with-input-from-string (in "void
SikosApplication::autoAlignmentValue(double rms, double pv, double focus, double xtilt, double ytilt)")
(feed in))
(with-input-from-string (in "SikosSetting::SikosSetting(QObject *parent/* = 0 */)")
  (feed in))
(with-input-from-string (in "bool
SikosSetting::setWork(const QString& name, double r, double eff, const QHash<QString,QString>& table)")
(feed in))
(with-input-from-string (in "bool
SikosSetting::getCorrection(int index) const")
(feed in))
(with-input-from-string (in "WebServicePanel::WebServicePanel(QWidget *parent/* = 0 */, Qt::WindowFlags f/* = 0 */)
: QWidget(parent, f)")
(feed in))
(with-input-from-string (in "bool
WavefrontMeasurementPanel::isSaved() const")
(feed in))
|#