added delphi stuff

added templet for ultrastar .pas files
added some delphi snippets for procedures and functions
added imenu stuff for delphi-code

1 files changed, 175 insertions, 0 deletions

diff --git a/emacs b/emacs
index 0fe2b43..540c469 100644
--- a/emacs
+++ b/emacs
@@ -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)