| git.druid.rocks | index | druid520 | radium | radium-stub.el |
radium-stub.el
;;; radium-stub.el, function stubs generated from c/ada/perl prototypes -*- lexical-binding: t; -*-
;;
;; the "function filler": i keep a prototype list at the top of a
;; program, and one key turns every prototype into a full stub block in
;; my style, leaving point inside the first block ready to fill.
;;
;; c: type on its own line, braces on their own lines, tabs, base
;; return right below point:
;; int ls(char* path); -> int
;; ls(char* path)
;; {
;; | <- point
;; return 0;
;; }
;;
;; ada/spark: `is`/`begin`/`end Name;` with 3-space indent (gnat's own
;; convention), same sentinel placement:
;; function Bar (X : Integer) return Integer; ->
;; function Bar (X : Integer) return Integer is
;; begin
;; | <- point
;; return 0;
;; end Bar;
;;
;; perl: brace on the same line, tabs, bare return - a `sub name($$);'
;; prototype keeps its prototype parens, a plain `sub name;' doesn't:
;; sub foo($$); -> sub foo($$) {
;; | <- point
;; return;
;; }
;;
;; languages with no separate prototype/definition split (scheme, sh,
;; asm, kona, forth, elisp) aren't here - there's nothing to fill from.
;;
;; base returns: c pointers get NULL, floats 0.0, ints 0, void none;
;; ada access types get null, floats 0.0, booleans False, strings "",
;; integers 0, character ' ', unknown types leave the body empty for me
;; to fill; perl always gets a bare return. parameter lists stay
;; verbatim, c's extern is dropped, static kept. real calls, variable
;; decls, typedefs and #defines all bounce off the parser, so a
;; whole-buffer pass stays clean.
(defvar radium-stub-c-control
'("return" "sizeof" "if" "for" "while" "do" "switch" "case"
"default" "else" "break" "continue" "goto")
"control keywords that can never open a c prototype's return type.")
(defun radium-stub-parse (line)
"parse a c, ada or perl prototype LINE into (lang ret name params), or
nil when the line isn't one. LANG is `c', `ada' or `perl'; for ada RET is
\"\" when it's a procedure, for perl RET is the prototype parens."
(let ((l (string-trim (replace-regexp-in-string
"/\\*.*\\*/\\|//.*\\|--.*\\|#.*" "" line))))
(or (radium-stub-parse-ada l)
(radium-stub-parse-perl l)
(radium-stub-parse-c l))))
(defun radium-stub-parse-perl (l)
"parse a perl `sub name(PROTO);' line L into ('perl proto name \"\"),
or nil. plain forward decls `sub name;' give an empty proto."
(when (string-match
"\\`sub[ \t]+\\([A-Za-z_][A-Za-z0-9_]*\\)\\([ \t]*(\\([^;]*\\))\\)?[ \t]*;\\'"
l)
(list 'perl (or (match-string 3 l) "") (match-string 1 l) "")))
(defun radium-stub-parse-ada (l)
"parse an ada prototype line L into ('ada ret name params), or nil.
handles bare `procedure Foo;' and quoted operator names like \"+\"."
(when (string-match
"\\`\\(procedure\\|function\\)[ \t]+\\(\"[^\"]+\"\\|[A-Za-z_][A-Za-z0-9_]*\\)\\([ \t]*(\\(.*\\))\\)?[ \t]*\\(return[ \t]+\\(.*\\)\\)?[ \t]*;\\'"
l)
(list 'ada
(or (match-string 6 l) "")
(match-string 2 l)
(replace-regexp-in-string
"[ \t]*;[ \t]*" "; " (string-trim (or (match-string 4 l) ""))))))
(defun radium-stub-parse-c (l)
"parse a c prototype line L into ('c ret name params), or nil."
(when (and (not (string-prefix-p "#" l))
(not (string-prefix-p "typedef" l))
(string-match
"\\`\\(.*\\)\\_<\\([A-Za-z_][A-Za-z0-9_]*\\)\\_>[ \t]*(\\(.*\\))[ \t]*;\\'"
l))
(let ((ret (string-trim (match-string 1 l)))
(name (match-string 2 l))
(params (replace-regexp-in-string
"[ \t]*,[ \t]*" ", " (string-trim (match-string 3 l)))))
(when (and (not (string-empty-p ret))
(not (string-match-p "[().=]" ret))
(not (member (car (split-string ret "[ \t]+" t))
(append radium-stub-c-control
'("procedure" "function" "sub")))))
(list 'c ret name params)))))
(defun radium-stub-return (lang rettype)
"the base return line for LANG (`c', `ada' or `perl') and RETTYPE, or nil
when there's no sensible one (void/procedure, or a type i don't know)."
(let ((ty (string-trim rettype)))
(cond
((eq lang 'ada)
(cond
((string-empty-p ty) nil)
((string-match-p "access" ty) "return null;")
((string-match-p "Boolean" ty) "return False;")
((string-match-p "String" ty) "return \"\";")
((string-match-p "Character" ty) "return ' ';")
((string-match-p "Float\\|Fixed\\|Duration" ty) "return 0.0;")
((string-match-p "Integer\\|Natural\\|Positive" ty) "return 0;")
(t nil)))
((eq lang 'perl) "return;")
(t
(cond
;; check for "*" before the bare-void check: in c-mode's actual
;; syntax table (unlike a fresh temp-buffer's), "*" ends a symbol
;; right after it, so \_<void\_> matches inside "void*" too and
;; would wrongly skip the return - checking "*" first sidesteps
;; that regardless of how void/void* get tokenized.
((string-match-p "\\*" ty) "return NULL;")
((string-match-p "\\_<void\\_>" ty) nil)
((string-match-p "float\\|double" ty) "return 0.0;")
(t "return 0;"))))))
(defun radium-stub-render (lang rettype name params)
"one full stub block for LANG (`c', `ada' or `perl'), RETTYPE
NAME(PARAMS), in my style, with the @!@ sentinel where point should
land."
(cond
((eq lang 'ada)
(let ((ret (radium-stub-return lang rettype)))
(format "%s %s%s%s is\nbegin\n%s%s"
(if (string-empty-p rettype) "procedure" "function")
name
(if (string-empty-p params) "" (concat " (" params ")"))
(if (string-empty-p rettype) "" (concat " return " rettype))
(if ret (concat "\t@!@\n\t" ret "\n") "\t@!@\n")
(concat "end " name ";"))))
((eq lang 'perl)
(format "sub %s%s {\n\t@!@\n\treturn;\n}"
name
(if (string-empty-p rettype) "" (concat "(" rettype ")"))))
(t
(let ((ret (radium-stub-return lang rettype))
(ty (string-trim rettype)))
(format "%s\n%s(%s)\n{\n%s}"
(if (string-prefix-p "extern " ty) (substring ty 7) ty)
name
params
(if ret (concat "\t@!@\n\t" ret "\n") "\t@!@\n"))))))
(defun radium-stub--insert (text)
"insert TEXT and leave point where its @!@ sentinel was."
(let ((start (point)))
(insert text)
(goto-char start)
(if (search-forward "@!@" nil t)
(replace-match "")
(goto-char (point-max)))))
(defun radium-stub-defined-p (name)
"non-nil if NAME already has a real definition somewhere in the
buffer, not just a prototype - my c/ada/perl style always marks the
real thing differently from a bare `;'-terminated prototype: c's
`NAME(args)' sits alone on its own line (the return type is on the
line above, allman-style), perl's `sub NAME' is followed by a real
brace body instead of ending in `;', and ada's spec/body both end in
`NAME(...);' vs the body's trailing `is'."
(save-excursion
(goto-char (point-min))
(or
(re-search-forward (concat "^" (regexp-quote name) "[ \t]*(.*)[ \t]*$") nil t)
(re-search-forward (concat "^sub[ \t]+" (regexp-quote name) "\\_>.*{") nil t)
(re-search-forward (concat "^sub[ \t]+" (regexp-quote name) "[ \t]*$") nil t)
(re-search-forward (concat "\\_<" (regexp-quote name) "\\_>.*[ \t]is[ \t]*$") nil t))))
(defun radium-stub-scan (beg end)
"every prototype between BEG and END, in order, as (lang ret name
params) lists."
(let (out)
(save-excursion
(goto-char beg)
(while (< (point) end)
(let ((p (radium-stub-parse
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
(when p (push p out)))
(forward-line 1)))
(nreverse out)))
(defun radium-stub-fill (beg end)
"generate a stub block for every c/ada/perl prototype line between BEG and
END, all inserted at point, leaving point in the first block's body
\(C-c c s). with no active region i scan the whole buffer."
(interactive (if (use-region-p)
(list (region-beginning) (region-end))
(list (point-min) (point-max))))
(let ((protos (seq-remove (lambda (p) (radium-stub-defined-p (nth 2 p)))
(radium-stub-scan beg end))))
(unless protos
(user-error "err: no undefined c/ada/perl prototypes between %d and %d." beg end))
(radium-stub--insert
(concat (string-join (mapcar (lambda (p) (apply #'radium-stub-render p))
protos)
"\n\n")
"\n"))))
(defun radium-stub-fill-at-point ()
"generate one stub block from the c/ada/perl prototype line point is on,
inserted two lines below it (C-c c S)."
(interactive)
(let ((p (radium-stub-parse
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
(unless p
(user-error "err: no prototype on this line."))
(when (radium-stub-defined-p (nth 2 p))
(user-error "err: %s is already defined." (nth 2 p)))
(end-of-line)
(newline 2)
(radium-stub--insert (apply #'radium-stub-render p))))
(global-set-key (kbd "C-c c s") #'radium-stub-fill)
(global-set-key (kbd "C-c c S") #'radium-stub-fill-at-point)
(provide 'radium-stub)