Commit | Line | Data |
---|---|---|
de41117e KN |
1 | ;;; guile-c.el --- Guile C editing commands |
2 | ||
6e7d5622 | 3 | ;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. |
de41117e | 4 | |
53befeb7 NJ |
5 | ;;;; This library is free software; you can redistribute it and/or |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free | |
17 | ;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA | |
18 | ;;;; 02111-1307 USA | |
de41117e KN |
19 | |
20 | ;;; Commentary: | |
21 | ||
22 | ;; (add-hook 'c-mode-hook | |
23 | ;; (lambda () | |
24 | ;; (require 'guile-c) | |
de41117e | 25 | ;; (define-key c-mode-map "\C-c\C-g\C-p" 'guile-c-insert-define) |
ac667929 | 26 | ;; (define-key c-mode-map "\C-c\C-g\C-e" 'guile-c-edit-docstring) |
468bd77e | 27 | ;; (define-key c-mode-map "\C-c\C-g\C-d" 'guile-c-deprecate-region) |
de41117e KN |
28 | ;; )) |
29 | ||
30 | ;;; Code: | |
31 | ||
32 | (require 'cc-mode) | |
33 | ||
34 | (defvar guile-c-prefix "scm_") | |
35 | ||
468bd77e | 36 | \f |
de41117e KN |
37 | ;;; |
38 | ;;; Insert templates | |
39 | ;;; | |
40 | ||
41 | (defun guile-c-insert-define () | |
42 | "Insert a template of a Scheme procedure. | |
43 | ||
44 | M-x guile-c-insert-define RET foo arg , opt . rest => | |
45 | ||
46 | SCM_DEFINE (scm_foo, \"foo\", 1, 1, 1, | |
47 | (SCM arg, SCM opt, SCM rest), | |
48 | \"\") | |
49 | #define FUNC_NAME s_scm_foo | |
50 | { | |
51 | ||
52 | } | |
53 | #undef FUNC_NAME" | |
54 | (interactive) | |
55 | (let ((tokens (split-string (read-string "Procedure: "))) | |
56 | name args opts rest) | |
57 | ;; Get procedure name | |
58 | (if (not tokens) (error "No procedure name")) | |
59 | (setq name (car tokens) tokens (cdr tokens)) | |
60 | ;; Get requisite arguments | |
61 | (while (and tokens (not (member (car tokens) '("," ".")))) | |
62 | (setq args (cons (car tokens) args) tokens (cdr tokens))) | |
63 | (setq args (nreverse args)) | |
64 | ;; Get optional arguments | |
65 | (when (string= (car tokens) ",") | |
66 | (setq tokens (cdr tokens)) | |
67 | (while (and tokens (not (string= (car tokens) "."))) | |
68 | (setq opts (cons (car tokens) opts) tokens (cdr tokens))) | |
69 | (setq opts (nreverse opts))) | |
70 | ;; Get rest argument | |
71 | (when (string= (car tokens) ".") | |
72 | (setq rest (list (cadr tokens)))) | |
73 | ;; Insert template | |
74 | (let ((c-name (guile-c-name-from-scheme-name name))) | |
75 | (insert (format "SCM_DEFINE (%s, \"%s\", %d, %d, %d,\n" | |
76 | c-name name (length args) (length opts) (length rest)) | |
77 | "\t (" | |
78 | (mapconcat (lambda (a) (concat "SCM " a)) | |
79 | (append args opts rest) ", ") | |
80 | "),\n" | |
81 | "\t \"\")\n" | |
82 | "#define FUNC_NAME s_" c-name "\n" | |
83 | "{\n\n}\n" | |
84 | "#undef FUNC_NAME\n\n") | |
85 | (previous-line 4) | |
86 | (indent-for-tab-command)))) | |
87 | ||
88 | (defun guile-c-name-from-scheme-name (name) | |
89 | (while (string-match "\\?$" name) (setq name (replace-match "_p" t t name))) | |
90 | (while (string-match "!$" name) (setq name (replace-match "_x" t t name))) | |
91 | (while (string-match "^%" name) (setq name (replace-match "sys_" t t name))) | |
92 | (while (string-match "->" name) (setq name (replace-match "_to_" t t name))) | |
93 | (while (string-match "[-:]" name) (setq name (replace-match "_" t t name))) | |
94 | (concat guile-c-prefix name)) | |
95 | ||
468bd77e | 96 | \f |
de41117e KN |
97 | ;;; |
98 | ;;; Edit docstrings | |
99 | ;;; | |
100 | ||
f7fd6a73 KN |
101 | (defvar guile-c-window-configuration nil) |
102 | ||
de41117e KN |
103 | (defun guile-c-edit-docstring () |
104 | (interactive) | |
105 | (let* ((region (guile-c-find-docstring)) | |
106 | (doc (if region (buffer-substring (car region) (cdr region))))) | |
107 | (if (not doc) | |
108 | (error "No docstring!") | |
f7fd6a73 | 109 | (setq guile-c-window-configuration (current-window-configuration)) |
de41117e KN |
110 | (with-current-buffer (get-buffer-create "*Guile Docstring*") |
111 | (erase-buffer) | |
112 | (insert doc) | |
113 | (goto-char (point-min)) | |
114 | (while (not (eobp)) | |
115 | (if (looking-at "[ \t]*\"") | |
116 | (delete-region (match-beginning 0) (match-end 0))) | |
117 | (end-of-line) | |
118 | (if (eq (char-before (point)) ?\") | |
119 | (delete-backward-char 1)) | |
120 | (if (and (eq (char-before (point)) ?n) | |
121 | (eq (char-before (1- (point))) ?\\)) | |
122 | (delete-backward-char 2)) | |
123 | (forward-line)) | |
124 | (goto-char (point-min)) | |
125 | (texinfo-mode) | |
126 | (if global-font-lock-mode | |
127 | (font-lock-fontify-buffer)) | |
128 | (local-set-key "\C-c\C-c" 'guile-c-edit-finish) | |
6c44688a | 129 | (setq fill-column 63) |
de41117e KN |
130 | (switch-to-buffer-other-window (current-buffer)) |
131 | (message "Type `C-c C-c' to finish"))))) | |
132 | ||
133 | (defun guile-c-edit-finish () | |
134 | (interactive) | |
135 | (goto-char (point-max)) | |
136 | (while (eq (char-before) ?\n) (backward-delete-char 1)) | |
137 | (goto-char (point-min)) | |
138 | (if (eobp) | |
139 | (insert "\"\"") | |
140 | (while (not (eobp)) | |
141 | (insert "\t \"") | |
142 | (end-of-line) | |
143 | (insert (if (eobp) "\"" "\\n\"")) | |
144 | (forward-line 1))) | |
145 | (let ((doc (buffer-string))) | |
146 | (kill-buffer (current-buffer)) | |
f7fd6a73 | 147 | (set-window-configuration guile-c-window-configuration) |
de41117e KN |
148 | (let ((region (guile-c-find-docstring))) |
149 | (goto-char (car region)) | |
150 | (delete-region (car region) (cdr region))) | |
151 | (insert doc))) | |
152 | ||
153 | (defun guile-c-find-docstring () | |
154 | (save-excursion | |
155 | (if (re-search-backward "^SCM_DEFINE" nil t) | |
156 | (let ((start (progn (forward-line 2) (point)))) | |
157 | (while (looking-at "[ \t]*\"") | |
158 | (forward-line 1)) | |
159 | (cons start (- (point) 2)))))) | |
160 | ||
468bd77e KN |
161 | \f |
162 | ;;; | |
163 | ;;; Others | |
164 | ;;; | |
165 | ||
166 | (defun guile-c-deprecate-region (start end) | |
167 | (interactive "r") | |
168 | (save-excursion | |
169 | (let ((marker (make-marker))) | |
170 | (set-marker marker end) | |
171 | (goto-char start) | |
172 | (insert "#if (SCM_DEBUG_DEPRECATED == 0)\n\n") | |
173 | (goto-char marker) | |
174 | (insert "\n#endif /* (SCM_DEBUG_DEPRECATED == 0) */\n")))) | |
175 | ||
de41117e KN |
176 | (provide 'guile-c) |
177 | ||
178 | ;; guile-c.el ends here |