diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs | 175 |
1 files changed, 175 insertions, 0 deletions
@@ -239,6 +239,181 @@ (setq cssm-newline-before-closing-bracket t) (setq cssm-indent-function #'cssm-c-style-indenter) +; delphi-mode +(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 + "[_a-zA-Z][_a-zA-Z0-9]*" ;;mymethod + "\\((.*)\\)?" ;;(myvar1:varType; myvar2:varType=defaultvalue) + "\\( *: *[_a-zA-Z][_a-zA-Z0-9]*\\)?") ;; : TReturnType + "\\)") + "Signature of a delphi method") + + +(defconst delphi-class-declaration-regexp + ;;like TMyClass = class(TParentClass) + "^ *\\([_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-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-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 "\\(?:\\(?:^\\|[^_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-in-class-definition pos)))) + (let ((class-name (if class-name (substring class-name 0 -1) class-def)) + (content (if class-def (cond ((assoc "Definition" (assoc class-def index-alist)) + (let ((alist (reverse (assoc "Definition" (assoc class-def index-alist))))) + (setcdr (assoc "Definition" (assoc class-def index-alist)) + (cdr (reverse (push (cons function-name pos) alist))))) + nil) + (t + (list "Definition" (cons function-name pos)))) + (cons function-name pos)))) + (message "%s" class-name) + (if content (cond + (class-name + (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) + (nreverse index-alist))) + +(add-hook 'delphi-mode-hook + '(lambda () + (setq comment-start "// ") + (require 'imenu) + (setq imenu-create-index-function + 'imenu--create-delphi-index) + (imenu-add-menubar-index))) + +(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))) + (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))) + ; removing annoyances (setq inhibit-startup-message t) (setq require-final-newline t) |