This is the mail archive of the guile@sources.redhat.com mailing list for the Guile project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

guile-c.el


Hello,

I've written some Emacs commands, which can be used to edit Guile C
files.  So far the following commands are defined:

  guile-c-insert-define-procedure - Insert a skeleton of a function
  guile-c-edit-docstring          - Edit docstring in a separate buffer

Setup:

  (add-hook 'c-mode-hook
    (lambda ()
      (require 'guile-c)
      (define-key c-mode-map "\C-c\C-d" 'guile-c-edit-docstring)
      (define-key c-mode-map "\C-c\C-i\C-p" 'guile-c-insert-define-procedure)
      ))

Usage:

M-x guile-c-insert-define-procedure RET foo arg , opt . rest =>

  SCM_DEFINE (scm_foo, "foo", 1, 1, 1,
              (SCM arg, SCM opt, SCM rest),
  "")
  #define FUNC_NAME s_scm_foo
  {
  
  }
  #undef FUNC_NAME

M-x guile-c-edit-docstring will extract the docstring and display it
in a separate buffer in Texinfo mode.  Type C-c C-c to finish editing.

Thanks,
Keisuke Nishida

------------------------------------------------------------------------
;;; guile-c.el --- C mode extension for Guile.

;; Copyright (C) 2000 Keisuke Nishida <kxn30@po.cwru.edu>

;; Author: Keisuke Nishida <kxn30@po.cwru.edu>
;; Keyword: guile, c
;; Version: 2000-07-09

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; (add-hook 'c-mode-hook
;;   (lambda ()
;;     (require 'guile-c)
;;     (define-key c-mode-map "\C-c\C-d" 'guile-c-edit-docstring)
;;     (define-key c-mode-map "\C-c\C-i\C-p" 'guile-c-insert-define-procedure)
;;     ))

;;; Code:

(require 'cc-mode)

(defvar guile-c-prefix "scm_")

;;;
;;; Insert skeleton
;;;

(defun guile-c-insert-define-procedure ()
  "Insert a skeleton of a Scheme procedure.

  M-x guile-c-insert-define-procedure RET foo arg , opt . rest =>

  SCM_DEFINE (scm_foo, \"foo\", 1, 1, 1,
              (SCM arg, SCM opt, SCM rest),
  \"\")
  #define FUNC_NAME s_scm_foo
  {
  
  }
  #undef FUNC_NAME"
  (interactive)
  (let ((tokens (split-string (read-string "Procedure name and args: ")))
	name args opts rest)
    ;; Get procedure name
    (if (not tokens) (error "No procedure name"))
    (setq name (car tokens) tokens (cdr tokens))
    ;; Get requisite arguments
    (while (and tokens (not (member (car tokens) '("," "."))))
      (setq args (cons (car tokens) args) tokens (cdr tokens)))
    (setq args (nreverse args))
    ;; Get optional arguments
    (when (string= (car tokens) ",")
      (setq tokens (cdr tokens))
      (while (and tokens (not (string= (car tokens) ".")))
	(setq opts (cons (car tokens) opts) tokens (cdr tokens)))
      (setq opts (nreverse opts)))
    ;; Get rest argument
    (when (string= (car tokens) ".")
      (setq rest (list (cadr tokens))))
    ;; Insert skeleton
    (let ((c-name (guile-c-name-from-scheme-name name)))
      (insert (format "SCM_DEFINE (%s, \"%s\", %d, %d, %d,\n"
		      c-name name (length args) (length opts) (length rest))
	      "\t    ("
	      (mapconcat (lambda (a) (concat "SCM " a))
			 (append args opts rest) ", ")
	      "),\n"
	      "\"\")\n"
	      "#define FUNC_NAME s_" c-name "\n"
	      "{\n\n}\n"
	      "#undef FUNC_NAME\n\n")
      (previous-line 4)
      (indent-for-tab-command))))

(defun guile-c-name-from-scheme-name (name)
  (while (string-match "-" name) (setq name (replace-match "_" t t name)))
  (while (string-match "?" name) (setq name (replace-match "_p" t t name)))
  (while (string-match "!" name) (setq name (replace-match "_x" t t name)))
  (concat guile-c-prefix name))

;;;
;;; Edit docstrings
;;;

(defun guile-c-edit-docstring ()
  (interactive)
  (let* ((region (guile-c-find-docstring))
	 (doc (if region (buffer-substring (car region) (cdr region)))))
    (if (not doc)
	(error "No docstring!")
      (with-current-buffer (get-buffer-create "*Guile Docstring*")
	(erase-buffer)
	(insert doc)
	(goto-char (point-min))
	(while (not (eobp))
	  (if (looking-at "[ \t]*\"")
	      (delete-region (match-beginning 0) (match-end 0)))
	  (end-of-line)
	  (if (eq (char-before (point)) ?\")
	      (delete-backward-char 1))
	  (if (and (eq (char-before (point)) ?n)
		   (eq (char-before (1- (point))) ?\\))
	      (delete-backward-char 2))
	  (forward-line))
	(goto-char (point-min))
	(texinfo-mode)
	(if global-font-lock-mode
	    (font-lock-fontify-buffer))
	(local-set-key "\C-c\C-c" 'guile-c-edit-finish)
	(switch-to-buffer-other-window (current-buffer))))))

(defun guile-c-edit-finish ()
  (interactive)
  (goto-char (point-min))
  (if (eobp)
      (insert "\"\"")
    (while (not (eobp))
      (insert "\"")
      (end-of-line)
      (insert (if (eobp) "\"" "\\n\""))
      (forward-line 1)))
  (let ((doc (buffer-string)))
    (kill-buffer (current-buffer))
    (delete-window (selected-window))
    (let ((region (guile-c-find-docstring)))
      (goto-char (car region))
      (delete-region (car region) (cdr region)))
    (insert doc)))

(defun guile-c-find-docstring ()
  (save-excursion
    (if (re-search-backward "^SCM_DEFINE" nil t)
	(let ((start (progn (forward-line 2) (point))))
	  (while (looking-at "[ \t]*\"")
	    (forward-line 1))
	  (cons start (- (point) 2))))))

(provide 'guile-c)

;; guile-c.el ends here

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]