Getting SWIG to work with C++/Python

[Thien-Thi Nguyen]

"Brian Dam Pedersen" <brian.pedersen at mail.danbbs.dk> writes:

> SWIG is very picky with its C++ syntax. For example it chokes on the
> following code from VC++

please find below work in progress towards being able to automatically
extract swig-compatible interface specs from C++ header files.  it is
not useful yet, having only attained rudimentary syntax analysis.  still
to go are:

- semantic analysis: (me L-paren R-paren) => default-ctor
- semantic mapping: ctors => __init__, operator+= => __add__, etc
- generation of swig/Foo.cc when ../Foo.h has inlined definitions
- hooks for class-specific tweaks and/or overrides
- documentation and an emacs mode ;->

however, i'm hoping that by posting it here others may hack on it to make
things better more quickly than i can by myself.  if so, please send code
improvements to ttnttn at scripps.edu.

swig author d.beazley says SWIG1.3 will be itself swiggable, in which case
some of this code will be replaced by calls to swig.

happy hacking!

thi, who hopes to never have to actually write python by hand <shudder>


---------------------
;;; swigpp.el --- make swig interface files from annotated C++ headers
;;; ID: $Id: swigpp.el,v 1.16 2000/01/05 16:59:11 ttnttn Exp $
;;; SOURCE: $Source: /home/ttnttn/repo/mead/swig/swigpp.el,v $

;;; Commentary:

;; This file provides the command `swigpp-process-file' and its batch variant,
;; `batch-swigpp-process-file'.  Args are IN-FILE-NAME (usually "../Foo.h"),
;; OUT-FILE-NAME (usually "Foo.j") and MODULE-NAME (usually "Foo").  See the
;; GNUmakefile in this directory for `batch-swigpp-process-file' usage.
;;
;; The input file is searched for class declarations prefixed with "//!wrap!"
;; directives.  For each such class, the public members are processed to form
;; a swig-compatible class declaration in the output file.  Class members
;; prefixed w/ "//!nowrap!" are ignored, as are all text between "//!nowrap!+"
;; and "//!nowrap!-".
;;
;; In the output, ctors and dtors are grouped first, followed by operators,
;; followed by other class members.

;; Caveat: As of $Revision: 1.16 $, the swig-compatible processing is not yet
;; implemented; i.e., the text of the class members is used directly, w/o
;; further analysis.  TODO TODO TODO.

;;; Code:

(require 'cl)				; sanity

;;;---------------------------------------------------------------------------
;;; Variables

(defvar swigpp-debug nil
  "Non-nil means swigpp.el writes debugging info to the output file.")

(defvar swigpp-wrap-one "//!wrap!"
  "Directive to wrap the next class or member.")
(defvar swigpp-nowrap-one "//!nowrap!"
  "Directive to not wrap the next class or member.")
(defvar swigpp-nowrap-start "//!nowrap!+"
  "Directive to start not wrapping successive following members.")
(defvar swigpp-nowrap-end "//!nowrap!-"
  "Directive to stop not wrapping successive members.")

;;;---------------------------------------------------------------------------
;;; Signature analysis support functions

(defun sa-point-syntax-string ()
  (char-to-string (char-syntax (char-after (point)))))

(defun sa-tokenize (b e)
  (save-excursion
    (goto-char b)
    (let ((me (cons 'w (intern (get 'swigpp 'name))))
	  (state (sa-point-syntax-string))
	  tokens snekot)
      ;; first go one direction
      (while (< (point) e)
	(if (or (looking-at "//.*") (looking-at "public:"))
	    (goto-char (match-end 0))
	  (let ((token (cons state
			     (buffer-substring
			      (point)
			      (+ (point) (skip-syntax-forward state e))))))
	    (unless (string-match "[-> ]" state)	;;; ignore whitespace
	      (push (if (string= "w" (car token))
			(cons (intern (car token)) (intern (cdr token)))
		      token)
		    snekot))))
	(setq state (sa-point-syntax-string)))
      ;; remove cruft
      (when (equal '("." . ";") (car snekot))
	(setq snekot (cdr snekot)))
      (when (equal '(w . const) (car snekot))
	(setq snekot (cdr snekot)))
      ;; now go the other direction
      (while snekot
	(let ((one (car snekot))
	      (two (cadr snekot)))
	  (cond ((and (string= "." (car one))
		      (equal '(w . operator) two))
		 (push (cons 'operator (cdr one)) tokens)
		 (setq snekot (cddr snekot)))
		((equal '("(" . "(") one)
		 (push 'L-paren tokens)
		 (setq snekot (cdr snekot)))
		((equal '(")" . ")") one)
		 (push 'R-paren tokens)
		 (setq snekot (cdr snekot)))
		((equal '("." . ",") one)
		 (push 'comma tokens)
		 (setq snekot (cdr snekot)))
		((and (equal '("." . "&") one)
		      (equal me two))
		 (push 'me-ref tokens)
		 (setq snekot (cddr snekot)))
		((equal me one)
		 (push 'me tokens)
		 (setq snekot (cdr snekot)))
		((equal '(w . const) one)
		 (push 'const tokens)
		 (setq snekot (cdr snekot)))
		(t
		 (push one tokens)
		 (setq snekot (cdr snekot))))))
      tokens)))

;;;---------------------------------------------------------------------------
;;; Support functions

(defun swigpp-ibuf () (get 'swigpp 'ibuf))
(defun swigpp-obuf () (get 'swigpp 'obuf))

(defun swigpp-intangiate-region (b e)
  (put-text-property b e 'swigpp-intangible t))

(defun swigpp-intangible-p (p)
  (get-text-property p 'swigpp-intangible))

(defun swigpp-insert (&rest s)
  (with-current-buffer (swigpp-obuf)
    (apply 'insert s)))

(defun swigpp-append (b e &optional if-0 comment)
  (when if-0 (swigpp-insert "#if 0" (if comment "" "\n")))
  (when comment (swigpp-insert "  // " comment "\n"))
  (append-to-buffer (swigpp-obuf) b e)
  (when if-0 (swigpp-insert "#endif\n")))

(defun swigpp-next-member ()
  "Advance point past newline following end of member.  Return region.
If a the ending regexp is not found, return nil."
  (let ((v (let ((beg (point)) debug-point)
	     (when (re-search-forward ";.*\n" (point-max) t)
	       (if (swigpp-intangible-p (1- (point)))
		   (progn
		     (when swigpp-debug (setq debug-point (1- (point))))
		     (goto-char (next-single-property-change
				 (1- (point))
				 'swigpp-intangible))
		     (when swigpp-debug
		       (message "moved from %d to %d" debug-point (point)))
		     (swigpp-next-member))
		 (list beg (point)))))))
    (when swigpp-debug
      (if (not v)
	  (message "<<<>>>>")
	(message "<<<")
	(message (apply 'buffer-substring v))
	(message ">>>")))
    v))

(defun swigpp-mask-non-public (name)
  (let (end)
    (goto-char (point-max))
    (while (progn (setq end (point))
		  (re-search-backward
		   "^\\(\\(public\\)\\|\\(private\\)\\|\\(protected\\)\\):"
		   (point-min) t))
      (let ((md (match-data)))
	(when (or (nth 6 md) (nth 8 md)) ; private or protected
	  (goto-char (match-beginning 0))
	  (when swigpp-debug
	    (swigpp-append (point) end t "non-public"))
	  (swigpp-intangiate-region (point) end))))))

(defun swigpp-mask-nowrap-region (name)
  (goto-char (point-min))
  (while (search-forward swigpp-nowrap-start (point-max) t)
    (let ((beg (progn (beginning-of-line) (point))))
      (search-forward swigpp-nowrap-end)
      (end-of-line) (forward-char 1)
      (when swigpp-debug
	(swigpp-append beg (point) t "nowrap region"))
      (swigpp-intangiate-region beg (point)))))

(defun swigpp-mask-single-nowrap (name)
  (goto-char (point-min))
  (let ((single-re (concat (regexp-quote swigpp-nowrap-one) "$")))
    (while (re-search-forward single-re (point-max) t)
      (let ((beg (progn (beginning-of-line) (point)))
	    (end (cadr (swigpp-next-member))))
	(when swigpp-debug
	  (swigpp-append beg end t "single nowrap"))
	(swigpp-intangiate-region beg end)))))

(defun swigpp-simple-re-snarf (re)
  (goto-char (point-min))
  (let (member match-p)
    (while (setq member (swigpp-next-member)
		 match-p (string-match re (apply 'buffer-substring member)))
      (swigpp-insert (format "  // %S\n" (apply 'sa-tokenize member)))
      (apply 'swigpp-append member)
      (apply 'swigpp-intangiate-region member))))

(defun swigpp-snarf-ctors-dtors (name)
  (message "Snarfing ctors dtors...")
  (swigpp-insert "\n  // ctors and dtors\n")
  (swigpp-simple-re-snarf (concat "^\\s-*~*\\<" name "\\>\\s-*(")))

(defun swigpp-snarf-operators (name)
  (message "Snarfing operators...")
  (swigpp-insert "\n  // operators\n")
  (swigpp-simple-re-snarf "\\<operator\\>"))

(defun swigpp-maybe-snarf-member (name b e)
  (when swigpp-debug
    (message "swigpp-maybe-snarf-member:\n%s" (buffer-substring b e)))
  (swigpp-append b e))

(defun swigpp-process-class (name)
  (swigpp-insert "class " name " {\npublic:\n")
  (let ((procs '(swigpp-mask-non-public
		 swigpp-mask-nowrap-region
		 swigpp-mask-single-nowrap
		 swigpp-snarf-ctors-dtors
		 swigpp-snarf-operators
		 ;; Add new procs here.
		 )))
    (while procs
      (funcall (car procs) name)
      (setq procs (cdr procs))))
  (message "Snarfing other things...")
  (swigpp-insert "\n  // other things\n")
  (goto-char (point-min))
  (let (member)
    (while (setq member (swigpp-next-member))
      (apply 'swigpp-maybe-snarf-member name member)))
  (swigpp-insert "}; // " name "\n\n"))

;;;---------------------------------------------------------------------------
;;; Entry points

(defun* swigpp-process-file (inf outf module-name)
  (let (c++-mode-hook find-file-hooks hs-minor-mode-hook)
    (put 'swigpp 'obuf (find-file outf))
    (erase-buffer)
    (insert "// Written " (format-time-string "%c") "\n")
    (insert "// Do not edit -- autogenerated file.\n\n")
    (insert "%module " module-name "\n")
    (insert "%{\n#include \"" inf "\"\n%}\n\n")
    (put 'swigpp 'ibuf (find-file inf))
    (modify-syntax-entry ?_ "w")
    (goto-char (point-min))
    (let ((class-id-re (concat (regexp-quote swigpp-wrap-one)
			       ".*\nclass\\s-+\\([a-zA-Z0-9_]+\\)\\s-*"))
	  (classes nil))
      (while (re-search-forward class-id-re (point-max) t)
	(push (list (match-string 1)
		    (1+ (point))
		    (progn (forward-sexp 1) (1- (point))))
	      classes))
      (unless classes
	(message "No classes found, not writing %s" outf)
	(return-from swigpp-process-file))
      (setq classes (nreverse classes))
      (message "Found classes: %s" (mapconcat 'car classes " "))
      (while classes
	(widen)
	(apply 'narrow-to-region (cdar classes))
	(let (buffer-read-only)
	  (put 'swigpp 'name (caar classes))
	  (swigpp-process-class (caar classes)))
	(setq classes (cdr classes))))
    (widen)
    (with-current-buffer (swigpp-obuf)
      ;; kludge
      (goto-char (point-min))
      (while (search-forward "{\npublic:\n" (point-max) t)
	(when (search-forward "\n\npublic:" (point-max) t)
	  (replace-match "")))
      (save-buffer))
    (kill-buffer (swigpp-obuf))
    (set-buffer (swigpp-ibuf))
    (set-buffer-modified-p nil)
    (kill-buffer (swigpp-ibuf))
    (setplist 'swigpp nil)))

(defun batch-swigpp-process-file ()
  (apply 'swigpp-process-file command-line-args-left))

;;;---------------------------------------------------------------------------
;;; Load-time actions

(provide 'swigpp)

;;; swigpp.el ends here