From 7e26a6c339371c348dfda84ea7314c2148572b09 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Sat, 16 Nov 2013 17:36:14 -0500 Subject: [PATCH] Add CFEngine 3 ElDoc, completion, and compilation glue to cf-promises. * progmodes/cfengine.el: Version bump. (cfengine-cf-promises): New defcustom to locate cf-promises. (cfengine3-vartypes): Add new "data" type. (cfengine3--current-word): New function to get current name-like word or its bounds. (cfengine3--current-function): New function to look up a CFEngine function's definition. (cfengine3-format-function-docstring): New function. (cfengine3-make-syntax-cache): New function. (cfengine3-documentation-function): New function: ElDoc glue. (cfengine3-completion-function): New function: completion glue. (cfengine3-mode): Set `compile-command', `eldoc-documentation-function', and add to `completion-at-point-functions'. --- lisp/ChangeLog | 17 +++++ lisp/progmodes/cfengine.el | 148 ++++++++++++++++++++++++++++++++++++- 2 files changed, 163 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ce887ff3e11..2b4f941048c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,20 @@ +2013-11-16 Teodor Zlatanov + + * progmodes/cfengine.el: Version bump. + (cfengine-cf-promises): New defcustom to locate cf-promises. + (cfengine3-vartypes): Add new "data" type. + (cfengine3--current-word): New function to get current name-like + word or its bounds. + (cfengine3--current-function): New function to look up a CFEngine + function's definition. + (cfengine3-format-function-docstring): New function. + (cfengine3-make-syntax-cache): New function. + (cfengine3-documentation-function): New function: ElDoc glue. + (cfengine3-completion-function): New function: completion glue. + (cfengine3-mode): Set `compile-command', + `eldoc-documentation-function', and add to + `completion-at-point-functions'. + 2013-11-16 Michael Albinus * net/tramp-cmds.el (tramp-cleanup-connection): Clean up diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 85a9074760d..a5cd863f2e1 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -5,7 +5,7 @@ ;; Author: Dave Love ;; Maintainer: Ted Zlatanov ;; Keywords: languages -;; Version: 1.2 +;; Version: 1.3 ;; This file is part of GNU Emacs. @@ -45,6 +45,10 @@ ;; (add-to-list 'auto-mode-alist '("^cf\\." . cfengine2-mode)) ;; (add-to-list 'auto-mode-alist '("^cfagent.conf\\'" . cfengine2-mode)) +;; It's *highly* recommended that you enable the eldoc minor mode: + +;; (add-hook 'cfengine-mode-hook 'turn-on-eldoc-mode) + ;; This is not the same as the mode written by Rolf Ebert ;; , distributed with cfengine-2.0.5. It does ;; better fontification and indentation, inter alia. @@ -60,6 +64,18 @@ :group 'cfengine :type 'integer) +(defcustom cfengine-cf-promises + (or (executable-find "cf-promises") + (executable-find "/var/cfengine/bin/cf-promises") + (executable-find "/usr/bin/cf-promises") + (executable-find "/usr/local/bin/cf-promises") + (executable-find "~/bin/cf-promises")) + "The location of the cf-promises executable. +Used for syntax discovery and checking. Set to nil to disable +the `compile-command' override and the ElDoc support." + :group 'cfengine + :type 'file) + (defcustom cfengine-parameters-indent '(promise pname 0) "*Indentation of CFEngine3 promise parameters (hanging indent). @@ -127,6 +143,9 @@ bundle agent rcfiles (defvar cfengine-mode-debug nil "Whether `cfengine-mode' should print debugging info.") +(defvar cfengine-mode-syntax-cache nil + "Cache for `cfengine-mode' syntax trees obtained from 'cf-promises -s json'.") + (defcustom cfengine-mode-abbrevs nil "Abbrevs for CFEngine2 mode." :group 'cfengine @@ -167,7 +186,7 @@ This includes those for cfservd as well as cfagent.") (defconst cfengine3-vartypes (mapcar 'symbol-name - '(string int real slist ilist rlist irange rrange counter)) + '(string int real slist ilist rlist irange rrange counter data)) "List of the CFEngine 3.x variable types.")) (defvar cfengine2-font-lock-keywords @@ -501,6 +520,116 @@ Intended as the value of `indent-line-function'." ;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+:: ;; CATEGORY: [a-zA-Z_]+: +(defun cfengine3--current-word (&optional bounds) + "Propose a word around point in the current CFEngine 3 buffer." + (let ((c (char-after (point))) + (s (syntax-ppss))) + (when (not (nth 3 s)) ; not inside a string + (if bounds + (save-excursion + (let ((oldpoint (point)) + start end) + (skip-syntax-backward "w_") (setq start (point)) + (goto-char oldpoint) + (skip-syntax-forward "w_") (setq end (point)) + (when (not (and (eq start oldpoint) + (eq end oldpoint))) + (list start (point))))) + (and c + (memq (char-syntax c) '(?_ ?w)) + (current-word)))))) + +(defun cfengine3--current-function () + "Look up current CFEngine 3 function" + (let* ((syntax (assoc cfengine-cf-promises cfengine-mode-syntax-cache)) + (flist (assoc 'functions syntax))) + (when flist + (let ((w (cfengine3--current-word))) + (and w (assq (intern w) flist)))))) + +;; format from "cf-promises -s json", e.g. "sort" function: +;; ((category . "data") +;; (variadic . :json-false) +;; (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) +;; ((range . "lex,int,real,IP,ip,MAC,mac") (type . "option"))]) +;; (returnType . "slist") +;; (status . "normal")) + +(defun cfengine3-format-function-docstring (fdef) + (let* ((f (format "%s" (car-safe fdef))) + (def (cdr fdef)) + (rtype (cdr (assq 'returnType def))) + (plist (cdr (assq 'parameters def))) + (has-some-parameters (> (length plist) 0)) + (variadic (eq t (cdr (assq 'variadic def))))) + + ;; (format "[%S]%s %s(%s%s)" def + (format "%s %s(%s%s)" + (if rtype + (propertize rtype 'face 'font-lock-variable-name-face) + "???") + (propertize f 'face 'font-lock-function-name-face) + (mapconcat (lambda (p) + (let ((type (cdr (assq 'type p))) + (range (cdr (assq 'range p)))) + (cond + ((not (stringp type)) "???type???") + ((not (stringp range)) "???range???") + ;; options are lists of possible keywords + ((equal type "option") + (propertize (concat "[" range "]") + 'face + 'font-lock-keyword-face)) + ;; anything else is a type name as a variable + (t (propertize type + 'face + 'font-lock-variable-name-face))))) + plist + ", ") + (if variadic + (if has-some-parameters ", ..." "...") + "")))) + +(defun cfengine3-make-syntax-cache () + "Build the CFEngine 3 syntax cache. +Calls `cfengine-cf-promises' with \"-s json\"" + (when cfengine-cf-promises + (let ((loaded-json-lib (require 'json nil t)) + (syntax (assoc cfengine-cf-promises cfengine-mode-syntax-cache))) + (if (not loaded-json-lib) + (message "JSON library could not be loaded!") + (unless syntax + (with-demoted-errors + (with-temp-buffer + (call-process-shell-command cfengine-cf-promises + nil ; no input + t ; current buffer + nil ; no redisplay + "-s" "json") + (goto-char (point-min)) + (setq syntax (json-read)) + (setq cfengine-mode-syntax-cache + (cons (cons cfengine-cf-promises syntax) + cfengine-mode-syntax-cache))))))))) + +(defun cfengine3-documentation-function () + "Document CFengine 3 functions around point. +Intended as the value of `eldoc-documentation-function', which +see. Use it by executing `turn-on-eldoc-mode'." + (cfengine3-make-syntax-cache) + (let ((fdef (cfengine3--current-function))) + (when fdef + (cfengine3-format-function-docstring fdef)))) + +(defun cfengine3-completion-function () + "Return completions for function name around or before point." + (cfengine3-make-syntax-cache) + (let* ((bounds (cfengine3--current-word t)) + (syntax (assoc cfengine-cf-promises cfengine-mode-syntax-cache)) + (flist (assoc 'functions syntax))) + (when bounds + (append bounds (list (cdr flist)))))) + (defun cfengine-common-settings () (set (make-local-variable 'syntax-propertize-function) ;; In the main syntax-table, \ is marked as a punctuation, because @@ -549,6 +678,21 @@ to the action header." nil nil nil beginning-of-defun)) (setq-local prettify-symbols-alist cfengine3--prettify-symbols-alist) + ;; `compile-command' is almost never a `make' call with CFEngine so + ;; we override it + (when cfengine-cf-promises + (set (make-local-variable 'compile-command) + (concat cfengine-cf-promises + " -f " + (when buffer-file-name + (shell-quote-argument buffer-file-name))))) + + (set (make-local-variable 'eldoc-documentation-function) + #'cfengine3-documentation-function) + + (add-hook 'completion-at-point-functions + #'cfengine3-completion-function nil t) + ;; Use defuns as the essential syntax block. (set (make-local-variable 'beginning-of-defun-function) #'cfengine3-beginning-of-defun) -- 2.39.2