From f19dd70ece015509d52d0e9a7c113ccccad96e0e Mon Sep 17 00:00:00 2001 From: Alexander Sulfrian Date: Tue, 15 Dec 2009 11:31:46 +0100 Subject: added winring with ecb-compatibility, more delphi-mode improvments --- emacs.d/lisp/delphi-mode-ench.el | 224 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 224 insertions(+) create mode 100644 emacs.d/lisp/delphi-mode-ench.el (limited to 'emacs.d/lisp/delphi-mode-ench.el') diff --git a/emacs.d/lisp/delphi-mode-ench.el b/emacs.d/lisp/delphi-mode-ench.el new file mode 100644 index 0000000..04e017a --- /dev/null +++ b/emacs.d/lisp/delphi-mode-ench.el @@ -0,0 +1,224 @@ +;;; delphi-mode-ench.el +(setq delphi-unit-sections + '(implementation program library package)) + +(defconst delphi-method-types-regexp + "\\(procedure\\|function\\|constructor\\|destructor\\)" + "Regular expression for delphi method types") + +(defconst delphi-method-signature-regexp + ;; like mymethod(myvar1:varType; myvar2:varType=defaultvalue):TReturnType + (concat + "\\(" + (concat + ;; mymethod + "[_a-zA-Z][_a-zA-Z0-9]*" + + ;; (myvar1:varType; myvar2:varType=defaultvalue) + "\\((.*)\\)?" + + ;; : TReturnType + "\\( *: *[_a-zA-Z][_a-zA-Z0-9]*\\)?") + "\\)") + "Signature of a delphi method") + +(defconst delphi-class-declaration-regexp + ;;like TMyClass = class(TParentClass) + "\\(?:^\\|[ \t]\\)[ \t]*\\([_a-zA-Z][_a-zA-Z0-9]*\\) *= *class" + "Class declaration regexp") + +(defvar imenu--function-name-regexp-delphi + (concat + "^[ \t]*\\(function\\|procedure\\|constructor\\|destructor\\)[ \t]+" + "\\([_a-zA-Z][_a-zA-Z0-9]*\\.\\)?" + "\\([_a-zA-Z][_a-zA-Z0-9]*\\)") + "Re to get function/procedure names in Delphi.") + +(defun delphi-get-classes () + (save-excursion + (goto-char (point-min)) + + (let ((classes '())) + (while (re-search-forward delphi-class-declaration-regexp nil t) + (push (match-string-no-properties 1) classes)) + classes))) + +(defun delphi-in-string (&optional pos) + (delphi-is (delphi-token-kind (delphi-token-at (point))) delphi-strings)) + +(defun delphi-in-comment (&optional pos) + (delphi-is (delphi-token-kind (delphi-token-at (point))) delphi-comments)) + +(defun delphi-is-definition (&optional pos) + (let ((class (save-excursion (delphi-in-class-definition)))) + (if class class + (if pos (goto-char pos)) + (re-search-forward "\\(begin\\|implementation\\)" nil t) + (let ((match (match-string-no-properties 1))) + (if (or (equal match "implementation") (equal match "end")) 't 'nil))))) + +(defun delphi-in-class-definition (&optional pos) + (if pos (goto-char pos)) + + (let ((break 't) (class nil) (open-blocks 0) (max-negative 0)) + (while (and break + (re-search-backward (concat "\\(?:\\(?:^\\|[^_a-zA-Z0-9]\\)" + "\\(end\\|record\\|case\\|begin\\)" + "\\(?:$\\|[^_a-zA-Z0-9]\\)" + "\\|\\(?:^\\|[ \t]\\)" + "\\([_a-zA-Z][_a-zA-Z0-9]*\\)" + "[ \t]*=[ \t]*class\\)") nil t)) + + (let ((result (match-string-no-properties 1))) + (if (not (or (delphi-in-string) (delphi-in-comment))) + (cond ((equal result "end") + (setq open-blocks (+ open-blocks 1))) + ((or + (or + (equal result "record") + (equal result "case")) (equal result "begin")) + (setq open-blocks (- open-blocks 1)) + (setq max-negative (min open-blocks max-negative))) + + ('t (setq break nil) + (if (= open-blocks max-negative) + (setq class (match-string-no-properties 2)))))))) + class) +) + +(defun imenu--create-delphi-index (&optional regexp) + (let ((index-alist '()) + (progress-prev-pos 0) + (case-fold-search t)) + (goto-char (point-min)) + (imenu-progress-message progress-prev-pos 0) + (save-match-data + (while (re-search-forward + (or regexp imenu--function-name-regexp-delphi) + 'nil 't) + (imenu-progress-message progress-prev-pos) + (let ((pos (save-excursion + (beginning-of-line) + (if imenu-use-markers (point-marker) (point)))) + (function-name (match-string-no-properties 3)) + (class-name (match-string-no-properties 2))) + (let ((class-def (save-excursion (delphi-is-definition pos)))) + (let ((class-name (if class-name (substring class-name 0 -1) class-def)) + (content (let ((sub-alist (if (not (equal class-def 't)) + (assoc class-def index-alist) + index-alist))) + (if (not (equal class-def 'nil)) + (cond ((assoc "Definition" sub-alist) + (let ((alist (reverse (assoc "Definition" sub-alist)))) + (setcdr (assoc "Definition" sub-alist) + (cdr (reverse (push (cons function-name pos) alist))))) + nil) + (t + (list "Definition" (cons function-name pos)))) + (cons function-name pos))))) + + (if content (cond + ((not (or (equal class-name 'nil) (equal class-name 't))) + (cond ((assoc class-name index-alist) + (let ((alist (reverse (assoc class-name index-alist)))) + (setcdr (assoc class-name index-alist) + (cdr (reverse (push content alist)))))) + (t + (push (list class-name content) index-alist)) + )) + (t + (push content index-alist)))) + ))))) + (imenu-progress-message progress-prev-pos 100) + (setq index-alist (nreverse index-alist)) + + ; remove class-name if only one class exists + (if (equal (length index-alist) 1) (setq index-alist (cdr (car index-alist)))) + index-alist)) + +(defun delphi-method-jump () + (cond ((save-excursion (delphi-is-definition)) (delphi-go-to-method-implementation)) + ('t (delphi-go-to-method-definition)))) + +(defun delphi-go-to-method-definition () + "Move cursor to method definition of current edited method" + (interactive) + (re-search-backward (concat + delphi-method-types-regexp + " *" + "\\([_a-zA-Z][_a-zA-Z0-9]*\\)\\." + delphi-method-signature-regexp)) + (let + ((class (match-string 2)) + (method (match-string 3))) + (message "%s %s" class method) + (re-search-backward (concat class " *= *class")) + (re-search-forward method))) + + +(defun delphi-go-to-method-implementation () + "Move cursor to method implementation of method on current line" + (interactive) + (beginning-of-line) + (let (methodtype methodname class) + (re-search-forward (concat + delphi-method-types-regexp + " *" + delphi-method-signature-regexp)) + (setq methodtype (match-string 1) + methodname (match-string 2)) + (re-search-backward delphi-class-declaration-regexp) + (setq class (match-string 1)) + (re-search-forward (concat methodtype " +" class "\\." methodname)))) + + +(defun delphi-complete-method () + "Create the method skeleton for method definition under cursor" + (interactive) + (beginning-of-line) + (let (methodtype methodname class) + (re-search-forward (concat + delphi-method-types-regexp + " *" + delphi-method-signature-regexp)) + (setq methodtype (match-string 1) + methoddef (match-string 2)) + (re-search-backward delphi-class-declaration-regexp) + (setq class (match-string 1)) + (end-of-buffer) + (re-search-backward (concat + "\\(" + delphi-method-types-regexp + " *" + class + "\\)\\|implementation")) + (next-line) + (re-search-forward (concat + delphi-method-types-regexp + "\\|\\(initialization\\|finalization\\|end\\.\\)")) + (previous-line) + (newline 2) + (previous-line 2) + (insert (concat methodtype " " class "." methoddef ";")) + (newline) + (insert "begin") + (newline 2) + (insert "end;") + (previous-line))) + + +;;key binding +(add-hook 'delphi-mode-hook + '(lambda () + (define-key delphi-mode-map "\C-c\C-mi" 'delphi-go-to-method-implementation) + (define-key delphi-mode-map "\C-c\C-md" 'delphi-go-to-method-definition) + (define-key delphi-mode-map "\C-c\C-mc" 'delphi-complete-method))) + +; hook if starting delphi-mode +(add-hook 'delphi-mode-hook + '(lambda () + (setq comment-start "// ") + (require 'imenu) + (setq imenu-create-index-function + 'imenu--create-delphi-index) + (imenu-add-menubar-index))) -- cgit v1.2.3