This is the mail archive of the
guile@sources.redhat.com
mailing list for the Guile project.
guile-c.el
- To: guile at sourceware dot cygnus dot com
- Subject: guile-c.el
- From: Keisuke Nishida <kxn30 at po dot cwru dot edu>
- Date: 09 Jul 2000 07:41:57 -0400
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