nxhtml/related/visual-basic-mode.el

   1 ;;; visual-basic-mode.el
   2 ;; This is free software.
   3
   4 ;; A mode for editing Visual Basic programs.
   5 ;; Modified version of Fred White's visual-basic-mode.el
   6
   7 ;; Copyright (C) 1996 Fred White <fwhite@alum.mit.edu>
   8 ;; Copyright (C) 1998 Free Software Foundation, Inc.
   9 ;;   (additions by Dave Love)
  10 ;; Copyright (C) 2008-2009 Free Software Foundation, Inc.
  11 ;;   (additions by Randolph Fritz and Vincent Belaiche (VB1) )
  12
  13 ;; Author: Fred White <fwhite@alum.mit.edu>
  14 ;; Adapted-by: Dave Love <d.love@dl.ac.uk>
  15 ;;           : Kevin Whitefoot <kevin.whitefoot@nopow.abb.no>
  16 ;;           : Randolph Fritz <rfritz@u.washington.edu>
  17 ;;           : Vincent Belaiche (VB1) <vincentb1@users.sourceforge.net>
  18 ;; Version: 1.4.8 (2009-09-29)
  19 ;; Serial Version: %Id: 17%
  20 ;; Keywords: languages, basic, Evil
  21
  22
  23 ;; (Old) LCD Archive Entry:
  24 ;; basic-mode|Fred White|fwhite@alum.mit.edu|
  25 ;; A mode for editing Visual Basic programs.|
  26 ;; 18-Apr-96|1.0|~/modes/basic-mode.el.Z|
  27
  28 ;; This file is NOT part of GNU Emacs but the same permissions apply.
  29 ;;
  30 ;; GNU Emacs  is free software;  you can redistribute it and/or modify
  31 ;; it under the terms of  the GNU General  Public License as published
  32 ;; by  the Free Software  Foundation;  either version  2, or (at  your
  33 ;; option) any later version.
  34 ;;
  35 ;; GNU  Emacs is distributed  in the hope that  it will be useful, but
  36 ;; WITHOUT    ANY  WARRANTY;  without even the     implied warranty of
  37 ;; MERCHANTABILITY or FITNESS FOR A  PARTICULAR PURPOSE.  See the  GNU
  38 ;; General Public License for more details.
  39 ;;
  40 ;; You should have received  a copy of  the GNU General Public License
  41 ;; along with GNU Emacs; see  the file COPYING.  If  not, write to the
  42 ;; Free Software Foundation, 675  Mass Ave, Cambridge, MA 02139,  USA.
  43 ;; This  program  is free  software;  you  can  redistribute it and/or
  44 ;; modify it  under  the terms of the  GNU  General Public License  as
  45 ;; published by the Free Software  Foundation; either version 2 of the
  46 ;; License, or (at your option) any later version.
  47
  48 ;;; Commentary:
  49
  50 ;; Purpose of this package:
  51 ;;  This is a mode for editing programs written in The World's Most
  52 ;;  Successful Programming Language.  It features automatic
  53 ;;  indentation, font locking, keyword capitalization, and some minor
  54 ;;  convenience functions.
  55
  56 ;; Installation instructions
  57 ;;  Put visual-basic-mode.el somewhere in your path, compile it, and add
  58 ;;  the following to your init file:
  59
  60 ;;  (autoload 'visual-basic-mode "visual-basic-mode" "Visual Basic mode." t)
  61 ;;  (setq auto-mode-alist (append '(("\\.\\(frm\\|bas\\|cls\\)$" .
  62 ;;                                  visual-basic-mode)) auto-mode-alist))
  63 ;;
  64 ;;  If you are doing Rhino scripts, add:
  65 ;;  (setq auto-mode-alist (append '(("\\.\\(frm\\|bas\\|cls\\|rvb\\)$" .
  66 ;;                                  visual-basic-mode)) auto-mode-alist))
  67
  68 ;;  If you had visual-basic-mode already installed, you may need to call
  69 ;;  visual-basic-upgrade-keyword-abbrev-table the first time that
  70 ;;  visual-basic-mode is loaded.
  71
  72 ;; Of course, under Windows 3.1, you'll have to name this file
  73 ;; something shorter than visual-basic-mode.el
  74
  75 ;; Revisions:
  76 ;; 1.0 18-Apr-96  Initial version
  77 ;; 1.1 Accomodate emacs 19.29+ font-lock-defaults
  78 ;;     Simon Marshall <Simon.Marshall@esrin.esa.it>
  79 ;  1.2 Rename to visual-basic-mode
  80 ;; 1.3 Fix some indentation bugs.
  81 ;; 1.3+ Changes by Dave Love: [No attempt at compatibility with
  82 ;;      anything other than Emacs 20, sorry, but little attempt to
  83 ;;      sanitize for Emacs 20 specifically.]
  84 ;;      Change `_' syntax only for font-lock and imenu, not generally;
  85 ;;      provide levels of font-locking in the current fashion;
  86 ;;      font-lock case-insensitively; use regexp-opt with the font-lok
  87 ;;      keywords; imenu support; `visual-basic-split-line', bound to
  88 ;;      C-M-j; account for single-statement `if' in indentation; add
  89 ;;      keyword "Global"; use local-write-file-hooks, not
  90 ;;      write-file-hooks.
  91 ;; 1.4 September 1998
  92 ;; 1.4 KJW Add begin..end, add extra keywords
  93 ;;     Add customisation for single line if.  Disallow by default.
  94 ;;     Fix if regexp to require whitespace after if and require then.
  95 ;;     Add more VB keywords.  Make begin..end work as if..endif so
  96 ;;     that forms are formatted correctly.
  97 ;; 1.4.1 KJW Merged Dave Love and KJW versions.
  98 ;;     Added keywords suggested by Mickey Ferguson
  99 ;;     <MFerguson@peinc.com>
 100 ;;     Fixed imenu variable to find private variables and enums
 101
 102 ;;     Changed syntax class of =, <, > to punctuation to allow dynamic
 103 ;;     abbreviations to pick up only the word at point rather than the
 104 ;;     whole expression.
 105
 106 ;;     Fixed bug introduced by KJW adding suport for begin...end in
 107 ;;     forms whereby a single end outdented.
 108
 109 ;;     Partially fixed failure to recognise if statements with
 110 ;;     continuations (still fails on 'single line' if with
 111 ;;     continuation, ugh).
 112 ;; 1.4.2 RF added "class" and "null" keywords, "Rhino" script note.
 113 ;; 1.4.3 VB1 added
 114 ;;     1) function visual-basic-if-not-on-single-line to recognize single line
 115 ;;      if statements, even when line is broken.  variable
 116 ;;      visual-basic-allow-single-line-if default set to t again.
 117 ;;     2) use of 'words in calling regexp-opt rather than concat \\< ...\\>
 118 ;;     3) new keywords Preserve and Explicit
 119 ;; 1.4.4 VB1 added function visual-basic-close-block
 120 ;; 1.4.5 VB1, (expand-abbrev) within (save-excusion...)
 121 ;; 1.4.6 VB1 correct visual-basic-close-block (single line If case)
 122 ;; 1.4.7 VB1 correct visual-basic-close-block (For/Next)
 123 ;; 1.4.8 VB1 correct visual-basic-close-block (Property, + add With /End With)
 124 ;;           add command visual-basic-insert-item
 125
 126 ;; Lennart Borgman:
 127 ;; 2009-11-20
 128 ;; - Added eval-and-compile to visual-basic-label-regexp.
 129 ;;
 130 ;; Notes:
 131 ;; Dave Love
 132 ;; BTW, here's a script for making tags tables that I (Dave Love) have
 133 ;; used with reasonable success.  It assumes a hacked version of etags
 134 ;; with support for case-folded regexps.  I think this is now in the
 135 ;; development version at <URL:ftp://fly.cnuce.cnr.it/pub/> and should
 136 ;; make it into Emacs after 20.4.
 137
 138 ;; #! /bin/sh
 139
 140 ;; # etags-vb: (so-called) Visual (so-called) Basic TAGS generation.
 141 ;; # Dave Love <d.love@dl.ac.uk>.  Public domain.
 142 ;; # 1997-11-21
 143
 144 ;; if [ $# -lt 1 ]; then
 145 ;;     echo "Usage: `basename $0` [etags options] VBfile ... [etags options] " 1>&2
 146 ;;     exit 1
 147 ;; fi
 148
 149 ;; if [ $1 = "--help" ] || [ $1 = "-h" ]; then
 150 ;;     echo "Usage: `basename $0` [etags options] VBfile ... [etags options]
 151
 152 ;; "
 153 ;;     etags --help
 154 ;; fi
 155
 156 ;; exec etags --lang=none -c '/\(global\|public\)[ \t]+\(\(const\|type\)[ \t]+\)*\([a-z_0-9]+\)/\4/' \
 157 ;;     -c '/public[ \t]+\(sub\|function\|class\)[ \t]+\([a-z_0-9]+\)/\2/' \
 158 ;;   "$@"
 159
 160 ;; End Notes Dave Love
 161
 162
 163 ;; Known bugs:
 164 ;;  Doesn't know about ":" separated stmts
 165
 166
 167
 168 ;; todo:
 169 ;;  fwd/back-compound-statement
 170 ;;  completion over OCX methods and properties.
 171 ;;  IDE integration
 172 ;;  Change behaviour of ESC-q to recognise words used as paragraph
 173 ;;  titles and prevent them being dragged into the previous
 174 ;;  paragraph.
 175 ;;  etc.
 176
 177
 178 ;;; Code:
 179
 180 (provide 'visual-basic-mode)
 181
 182 (defvar visual-basic-xemacs-p (string-match "XEmacs\\|Lucid" (emacs-version)))
 183 (defvar visual-basic-winemacs-p (string-match "Win-Emacs" (emacs-version)))
 184 (defvar visual-basic-win32-p (eq window-system 'w32))
 185
 186 ;; Variables you may want to customize.
 187 (defvar visual-basic-mode-indent 8 "*Default indentation per nesting level.")
 188 (defvar visual-basic-fontify-p t "*Whether to fontify Basic buffers.")
 189 (defvar visual-basic-capitalize-keywords-p t
 190   "*Whether to capitalize BASIC keywords.")
 191 (defvar visual-basic-wild-files "*.frm *.bas *.cls"
 192   "*Wildcard pattern for BASIC source files.")
 193 (defvar visual-basic-ide-pathname nil
 194   "*The full pathname of your Visual Basic exe file, if any.")
 195 ;; VB
 196 (defvar visual-basic-allow-single-line-if t
 197   "*Whether to allow single line if")
 198
 199
 200 (defvar visual-basic-defn-templates
 201   (list "Public Sub ()\nEnd Sub\n\n"
 202         "Public Function () As Variant\nEnd Function\n\n"
 203         "Public Property Get ()\nEnd Property\n\n")
 204   "*List of function templates though which visual-basic-new-sub cycles.")
 205
 206 (defvar visual-basic-imenu-generic-expression
 207    '((nil "^\\s-*\\(public\\|private\\)*\\s-+\\(declare\\s-+\\)*\\(sub\\|function\\)\\s-+\\(\\sw+\\>\\)"
 208          4)
 209     ("Constants"
 210      "^\\s-*\\(private\\|public\\|global\\)*\\s-*\\(const\\s-+\\)\\(\\sw+\\>\\s-*=\\s-*.+\\)$\\|'"
 211      3)
 212     ("Variables"
 213      "^\\(private\\|public\\|global\\|dim\\)+\\s-+\\(\\sw+\\>\\s-+as\\s-+\\sw+\\>\\)"
 214      2)
 215     ("Types" "^\\(public\\s-+\\)*type\\s-+\\(\\sw+\\)" 2)))
 216
 217
 218
 219 (defvar visual-basic-mode-syntax-table nil)
 220 (if visual-basic-mode-syntax-table
 221     ()
 222   (setq visual-basic-mode-syntax-table (make-syntax-table))
 223   (modify-syntax-entry ?\' "\<" visual-basic-mode-syntax-table) ; Comment starter
 224   (modify-syntax-entry ?\n ">" visual-basic-mode-syntax-table)
 225   (modify-syntax-entry ?\\ "w" visual-basic-mode-syntax-table)
 226   (modify-syntax-entry ?\= "." visual-basic-mode-syntax-table)
 227   (modify-syntax-entry ?\< "." visual-basic-mode-syntax-table)
 228   (modify-syntax-entry ?\> "." visual-basic-mode-syntax-table)) ; Make =, etc., punctuation so that dynamic abbreviations work properly
 229
 230
 231 (defvar visual-basic-mode-map nil)
 232 (if visual-basic-mode-map
 233     ()
 234   (setq visual-basic-mode-map (make-sparse-keymap))
 235   (define-key visual-basic-mode-map "\t" 'visual-basic-indent-line)
 236   (define-key visual-basic-mode-map "\r" 'visual-basic-newline-and-indent)
 237   (define-key visual-basic-mode-map "\M-\r" 'visual-basic-insert-item)
 238   (define-key visual-basic-mode-map "\C-c\C-j" 'visual-basic-insert-item)
 239   (define-key visual-basic-mode-map "\M-\C-a" 'visual-basic-beginning-of-defun)
 240   (define-key visual-basic-mode-map "\M-\C-e" 'visual-basic-end-of-defun)
 241   (define-key visual-basic-mode-map "\M-\C-h" 'visual-basic-mark-defun)
 242   (define-key visual-basic-mode-map "\M-\C-\\" 'visual-basic-indent-region)
 243   (define-key visual-basic-mode-map "\M-q" 'visual-basic-fill-or-indent)
 244   (define-key visual-basic-mode-map "\M-\C-j" 'visual-basic-split-line)
 245   (define-key visual-basic-mode-map "\C-c]" 'visual-basic-close-block)
 246    (cond (visual-basic-winemacs-p
 247          (define-key visual-basic-mode-map '(control C) 'visual-basic-start-ide))
 248         (visual-basic-win32-p
 249          (define-key visual-basic-mode-map (read "[?\\S-\\C-c]") 'visual-basic-start-ide)))
 250   (if visual-basic-xemacs-p
 251       (progn
 252         (define-key visual-basic-mode-map "\M-G" 'visual-basic-grep)
 253         (define-key visual-basic-mode-map '(meta backspace) 'backward-kill-word)
 254         (define-key visual-basic-mode-map '(control meta /) 'visual-basic-new-sub))))
 255
 256
 257 ;; These abbrevs are valid only in a code context.
 258 (defvar visual-basic-mode-abbrev-table nil)
 259
 260 (defvar visual-basic-mode-hook ())
 261
 262
 263 ;; Is there a way to case-fold all regexp matches?
 264 ;; Change KJW Add enum, , change matching from 0 or more to zero or one for public etc.
 265 (eval-and-compile
 266   (defconst visual-basic-defun-start-regexp
 267     (concat
 268      "^[ \t]*\\([Pp]ublic \\|[Pp]rivate \\|[Ss]tatic\\|[Ff]riend \\)?"
 269      "\\([Ss]ub\\|[Ff]unction\\|[Pp]roperty +[GgSsLl]et\\|[Tt]ype\\|[Ee]num\\|[Cc]lass\\)"
 270      "[ \t]+\\(\\w+\\)[ \t]*(?")))
 271
 272
 273 (defconst visual-basic-defun-end-regexp
 274   "^[ \t]*[Ee]nd \\([Ss]ub\\|[Ff]unction\\|[Pp]roperty\\|[Tt]ype\\|[Ee]num\\|[Cc]lass\\)")
 275
 276 (defconst visual-basic-dim-regexp
 277   "^[ \t]*\\([Cc]onst\\|[Dd]im\\|[Pp]rivate\\|[Pp]ublic\\)\\_>"  )
 278
 279
 280 ;; Includes the compile-time #if variation.
 281 ;; KJW fixed if to require a whitespace so as to avoid matching, for
 282 ;; instance, iFileName and to require then.
 283
 284 ;; Two versions; one recognizes single line if just as though it were
 285 ;; a multi-line and the other does not.  Modified again to remove the
 286 ;; requirement for then so as to allow it to match if statements that
 287 ;; have continuations -- VB1 further elaborated on this for single line
 288 ;; if statement to be recognized on broken lines.
 289 ;;(defconst visual-basic-if-regexp
 290 ;;   "^[ \t]*#?[Ii]f[ \t]+.*[ \t]+[Tt]hen[ \t]*.*\\('\\|$\\)")
 291 (defconst visual-basic-if-regexp
 292    "^[ \t]*#?[Ii]f[ \t]+.*[ \t_]+")
 293
 294 (defconst visual-basic-ifthen-regexp "^[ \t]*#?[Ii]f.+\\<[Tt]hen\\>\\s-\\S-+")
 295
 296 (defconst visual-basic-else-regexp "^[ \t]*#?[Ee]lse\\([Ii]f\\)?")
 297 (defconst visual-basic-endif-regexp "[ \t]*#?[Ee]nd[ \t]*[Ii]f")
 298
 299 (defconst visual-basic-looked-at-continuation-regexp   "_[ \t]*$")
 300
 301 (defconst visual-basic-continuation-regexp
 302   (concat "^.*" visual-basic-looked-at-continuation-regexp))
 303
 304 (eval-and-compile
 305   (defconst visual-basic-label-regexp "^[ \t]*[a-zA-Z0-9_]+:$"))
 306
 307 (defconst visual-basic-select-regexp "^[ \t]*[Ss]elect[ \t]+[Cc]ase")
 308 (defconst visual-basic-case-regexp "^[ \t]*[Cc]ase")
 309 (defconst visual-basic-select-end-regexp "^[ \t]*[Ee]nd[ \t]+[Ss]elect")
 310
 311
 312 (defconst visual-basic-for-regexp "^[ \t]*[Ff]or\\b")
 313 (defconst visual-basic-next-regexp "^[ \t]*[Nn]ext\\b")
 314
 315 (defconst visual-basic-do-regexp "^[ \t]*[Dd]o\\b")
 316 (defconst visual-basic-loop-regexp "^[ \t]*[Ll]oop\\b")
 317
 318 (defconst visual-basic-while-regexp "^[ \t]*[Ww]hile\\b")
 319 (defconst visual-basic-wend-regexp "^[ \t]*[Ww]end\\b")
 320
 321 ;; Added KJW Begin..end for forms
 322 (defconst visual-basic-begin-regexp "^[ \t]*[Bb]egin)?")
 323 ;; This has created a bug.  End on its own in code should not outdent.
 324 ;; How can we fix this?  They are used in separate Lisp expressions so
 325 ;; add another one.
 326 (defconst visual-basic-end-begin-regexp "^[ \t]*[Ee]nd")
 327
 328 (defconst visual-basic-with-regexp "^[ \t]*[Ww]ith\\b")
 329 (defconst visual-basic-end-with-regexp "^[ \t]*[Ee]nd[ \t]+[Ww]ith\\b")
 330
 331 (defconst visual-basic-blank-regexp "^[ \t]*$")
 332 (defconst visual-basic-comment-regexp "^[ \t]*\\s<.*$")
 333
 334
 335 ;; This is some approximation of the set of reserved words in Visual Basic.
 336 (eval-and-compile
 337   (defvar visual-basic-all-keywords
 338   '("Add" "Aggregate" "And" "App" "AppActivate" "Application" "Array" "As"
 339     "Asc" "AscB" "Atn" "Attribute"
 340     "Beep" "Begin" "BeginTrans" "Boolean" "ByVal" "ByRef"
 341     "CBool" "CByte" "CCur"
 342     "CDate" "CDbl" "CInt" "CLng" "CSng" "CStr" "CVErr" "CVar" "Call"
 343     "Case" "ChDir" "ChDrive" "Character" "Choose" "Chr" "ChrB" "Class"
 344     "ClassModule" "Clipboard" "Close" "Collection" "Column" "Columns"
 345     "Command" "CommitTrans" "CompactDatabase" "Component" "Components"
 346     "Const" "Container" "Containers" "Cos" "CreateDatabase" "CreateObject"
 347     "CurDir" "Currency"
 348     "DBEngine" "DDB" "Data" "Database" "Databases"
 349     "Date" "DateAdd" "DateDiff" "DatePart" "DateSerial" "DateValue" "Day"
 350     "Debug" "Declare" "Deftype" "DeleteSetting" "Dim" "Dir" "Do"
 351     "DoEvents" "Domain"
 352     "Double" "Dynaset" "EOF" "Each" "Else" "Empty" "End" "EndProperty"
 353     "Enum" "Environ" "Erase" "Err" "Error" "Exit" "Exp" "Explicit" "FV" "False" "Field"
 354     "Fields" "FileAttr" "FileCopy" "FileDateTime" "FileLen" "Fix" "Font" "For"
 355     "Form" "FormTemplate" "Format" "Forms" "FreeFile" "FreeLocks" "Friend"
 356     "Function"
 357     "Get" "GetAllSettings" "GetAttr" "GetObject" "GetSetting" "Global" "GoSub"
 358     "GoTo" "Group" "Groups" "Hex" "Hour" "IIf" "IMEStatus" "IPmt" "IRR"
 359     "If" "Implements" "InStr" "Input" "Int" "Integer" "Is" "IsArray" "IsDate"
 360     "IsEmpty" "IsError" "IsMissing" "IsNull" "IsNumeric" "IsObject" "Kill"
 361     "LBound" "LCase" "LOF" "LSet" "LTrim" "Left" "Len" "Let" "Like" "Line"
 362     "Load" "LoadPicture" "LoadResData" "LoadResPicture" "LoadResString" "Loc"
 363     "Lock" "Log" "Long" "Loop" "MDIForm" "MIRR" "Me" "MenuItems"
 364     "MenuLine" "Mid" "Minute" "MkDir" "Month" "MsgBox" "NPV" "NPer" "Name"
 365     "New" "Next" "Not" "Now" "Nothing" "Null" "Object" "Oct" "On" "Open"
 366     "OpenDatabase"
 367     "Operator" "Option" "Optional"
 368     "Or" "PPmt" "PV" "Parameter" "Parameters" "Partition"
 369     "Picture" "Pmt" "Preserve" "Print" "Printer" "Printers" "Private"
 370         "ProjectTemplate" "Property"
 371     "Properties" "Public" "Put" "QBColor" "QueryDef" "QueryDefs"
 372     "RSet" "RTrim" "Randomize" "Rate" "ReDim" "Recordset" "Recordsets"
 373     "RegisterDatabase" "Relation" "Relations" "Rem" "RepairDatabase"
 374     "Reset" "Resume" "Return" "Right" "RmDir" "Rnd" "Rollback" "RowBuffer"
 375     "SLN" "SYD" "SavePicture" "SaveSetting" "Screen" "Second" "Seek"
 376     "SelBookmarks" "Select" "SelectedComponents" "SendKeys" "Set"
 377     "SetAttr" "SetDataAccessOption" "SetDefaultWorkspace" "Sgn" "Shell"
 378     "Sin" "Single" "Snapshot" "Space" "Spc" "Sqr" "Static" "Step" "Stop" "Str"
 379     "StrComp" "StrConv" "String" "Sub" "SubMenu" "Switch" "Tab" "Table"
 380     "TableDef" "TableDefs" "Tan" "Then" "Time" "TimeSerial" "TimeValue"
 381     "Timer" "To" "Trim" "True" "Type" "TypeName" "UBound" "UCase" "Unload"
 382     "Unlock" "Val" "Variant" "VarType" "Verb" "Weekday" "Wend"
 383     "While" "Width" "With" "Workspace" "Workspaces" "Write" "Year")))
 384
 385 (defvar visual-basic-font-lock-keywords-1
 386   (eval-when-compile
 387     (list
 388      ;; Names of functions.
 389      (list visual-basic-defun-start-regexp
 390            '(1 font-lock-keyword-face nil t)
 391            '(2 font-lock-keyword-face nil t)
 392            '(3 font-lock-function-name-face))
 393
 394      ;; Statement labels
 395      (cons visual-basic-label-regexp 'font-lock-keyword-face)
 396
 397      ;; Case values
 398      ;; String-valued cases get font-lock-string-face regardless.
 399      (list "^[ \t]*case[ \t]+\\([^'\n]+\\)" 1 'font-lock-keyword-face t)
 400
 401      ;; Any keywords you like.
 402      (list (regexp-opt
 403                           '("Dim" "If" "Then" "Else" "ElseIf" "End If") 'words)
 404            1 'font-lock-keyword-face))))
 405
 406 (defvar visual-basic-font-lock-keywords-2
 407   (append visual-basic-font-lock-keywords-1
 408           (eval-when-compile
 409             `((, (regexp-opt visual-basic-all-keywords 'words)
 410                    1 font-lock-keyword-face)))))
 411
 412 (defvar visual-basic-font-lock-keywords visual-basic-font-lock-keywords-1)
 413
 414
 415 (put 'visual-basic-mode 'font-lock-keywords 'visual-basic-font-lock-keywords)
 416
 417 ;;;###autoload
 418 (defun visual-basic-mode ()
 419   "A mode for editing Microsoft Visual Basic programs.
 420 Features automatic indentation, font locking, keyword capitalization,
 421 and some minor convenience functions.
 422 Commands:
 423 \\{visual-basic-mode-map}"
 424   (interactive)
 425   (kill-all-local-variables)
 426   (use-local-map visual-basic-mode-map)
 427   (setq major-mode 'visual-basic-mode)
 428   (setq mode-name "Visual Basic")
 429   (set-syntax-table visual-basic-mode-syntax-table)
 430
 431   ;;; This does not work in multi major modes.
 432   ;;(add-hook 'local-write-file-hooks 'visual-basic-untabify)
 433
 434   (setq local-abbrev-table visual-basic-mode-abbrev-table)
 435   (if visual-basic-capitalize-keywords-p
 436       (progn
 437         (make-local-variable 'pre-abbrev-expand-hook)
 438         (add-hook 'pre-abbrev-expand-hook 'visual-basic-pre-abbrev-expand-hook)
 439         (abbrev-mode 1)))
 440
 441   (make-local-variable 'comment-start)
 442   (setq comment-start "' ")
 443   (make-local-variable 'comment-start-skip)
 444   (setq comment-start-skip "'+ *")
 445   (make-local-variable 'comment-column)
 446   (setq comment-column 40)
 447   (make-local-variable 'comment-end)
 448   (setq comment-end "")
 449
 450   (make-local-variable 'indent-line-function)
 451   (setq indent-line-function 'visual-basic-indent-line)
 452
 453   (if visual-basic-fontify-p
 454       (visual-basic-enable-font-lock))
 455
 456   (make-local-variable 'imenu-generic-expression)
 457   (setq imenu-generic-expression visual-basic-imenu-generic-expression)
 458
 459   (set (make-local-variable 'imenu-syntax-alist) `((,(string-to-char "_") . "w")))
 460   (set (make-local-variable 'imenu-case-fold-search) t)
 461
 462   ;;(make-local-variable 'visual-basic-associated-files)
 463   ;; doing this here means we need not check to see if it is bound later.
 464   (add-hook 'find-file-hooks 'visual-basic-load-associated-files)
 465
 466   (run-hooks 'visual-basic-mode-hook))
 467
 468
 469 (defun visual-basic-enable-font-lock ()
 470   ;; Emacs 19.29 requires a window-system else font-lock-mode errs out.
 471   (cond ((or visual-basic-xemacs-p window-system)
 472
 473          ;; In win-emacs this sets font-lock-keywords back to nil!
 474          (if visual-basic-winemacs-p
 475              (font-lock-mode 1))
 476
 477          ;; Accomodate emacs 19.29+
 478          ;; From: Simon Marshall <Simon.Marshall@esrin.esa.it>
 479          (cond ((boundp 'font-lock-defaults)
 480                 (make-local-variable 'font-lock-defaults)
 481                 (setq font-lock-defaults
 482                       `((visual-basic-font-lock-keywords
 483                          visual-basic-font-lock-keywords-1
 484                          visual-basic-font-lock-keywords-2)
 485                         nil t ((,(string-to-char "_") . "w")))))
 486                (t
 487                 (make-local-variable 'font-lock-keywords)
 488                 (setq font-lock-keywords visual-basic-font-lock-keywords)))
 489
 490          (if visual-basic-winemacs-p
 491              (font-lock-fontify-buffer)
 492            (font-lock-mode 1)))))
 493
 494 ;; KJW should add some odds and bobs here to cover "end if" one way
 495 ;; could be to create the abbreviations by removing whitespace then we
 496 ;; could put "end if", "end with" and so on in the keyword table
 497 ;; Another idea would be to make it intelligent enough to substitute
 498 ;; the correct end for the construct (with, select, if)
 499 ;; Is this what the abbrev table hook entry is for?
 500 (defun visual-basic-construct-keyword-abbrev-table ()
 501   (if visual-basic-mode-abbrev-table
 502       nil
 503     (let ((words visual-basic-all-keywords)
 504           (word nil)
 505           (list nil))
 506       (while words
 507         (setq word (car words)
 508               words (cdr words))
 509         (setq list (cons (list (downcase word) word) list)))
 510
 511       (define-abbrev-table 'visual-basic-mode-abbrev-table list))))
 512
 513 ;; Would like to do this at compile-time.
 514 (visual-basic-construct-keyword-abbrev-table)
 515
 516
 517 (defun visual-basic-upgrade-keyword-abbrev-table ()
 518   "Use this in case of upgrading visual-basic-mode.el"
 519   (interactive)
 520
 521   (let ((words visual-basic-all-keywords)
 522                 (word nil)
 523                 (list nil))
 524         (while words
 525           (setq word (car words)
 526                         words (cdr words))
 527           (setq list (cons (list (downcase word) word) list)))
 528         (define-abbrev-table 'visual-basic-mode-abbrev-table list)))
 529
 530
 531 (defun visual-basic-in-code-context-p ()
 532   (if (fboundp 'buffer-syntactic-context) ; XEmacs function.
 533       (null (buffer-syntactic-context))
 534     ;; Attempt to simulate buffer-syntactic-context
 535     ;; I don't know how reliable this is.
 536     (let* ((beg (save-excursion
 537                   (beginning-of-line)
 538                   (point)))
 539            (list
 540             (parse-partial-sexp beg (point))))
 541       (and (null (nth 3 list))          ; inside string.
 542            (null (nth 4 list))))))      ; inside comment
 543
 544
 545 (defun visual-basic-pre-abbrev-expand-hook ()
 546   ;; Allow our abbrevs only in a code context.
 547   (setq local-abbrev-table
 548         (if (visual-basic-in-code-context-p)
 549             visual-basic-mode-abbrev-table)))
 550
 551
 552 (defun visual-basic-newline-and-indent (&optional count)
 553   "Insert a newline, updating indentation."
 554   (interactive)
 555   (save-excursion
 556     (expand-abbrev)
 557     (visual-basic-indent-line))
 558   (call-interactively 'newline-and-indent))
 559
 560 (defun visual-basic-beginning-of-defun ()
 561   (interactive)
 562   (re-search-backward visual-basic-defun-start-regexp))
 563
 564 (defun visual-basic-end-of-defun ()
 565   (interactive)
 566   (re-search-forward visual-basic-defun-end-regexp))
 567
 568 (defun visual-basic-mark-defun ()
 569   (interactive)
 570   (beginning-of-line)
 571   (visual-basic-end-of-defun)
 572   (set-mark (point))
 573   (visual-basic-beginning-of-defun)
 574   (if visual-basic-xemacs-p
 575       (zmacs-activate-region)))
 576
 577 (defun visual-basic-indent-defun ()
 578   (interactive)
 579   (save-excursion
 580     (visual-basic-mark-defun)
 581     (call-interactively 'visual-basic-indent-region)))
 582
 583
 584 (defun visual-basic-fill-long-comment ()
 585   "Fills block of comment lines around point."
 586   ;; Derived from code in ilisp-ext.el.
 587   (interactive)
 588   (save-excursion
 589     (beginning-of-line)
 590     (let ((comment-re "^[ \t]*\\s<+[ \t]*"))
 591       (if (looking-at comment-re)
 592           (let ((fill-prefix
 593                  (buffer-substring
 594                   (progn (beginning-of-line) (point))
 595                   (match-end 0))))
 596
 597             (while (and (not (bobp))
 598                         (looking-at visual-basic-comment-regexp))
 599               (forward-line -1))
 600             (if (not (bobp)) (forward-line 1))
 601
 602             (let ((start (point)))
 603
 604               ;; Make all the line prefixes the same.
 605               (while (and (not (eobp))
 606                           (looking-at comment-re))
 607                 (replace-match fill-prefix)
 608                 (forward-line 1))
 609
 610               (if (not (eobp))
 611                   (beginning-of-line))
 612
 613               ;; Fill using fill-prefix
 614               (fill-region-as-paragraph start (point))))))))
 615
 616
 617 (defun visual-basic-fill-or-indent ()
 618   "Fill long comment around point, if any, else indent current definition."
 619   (interactive)
 620   (cond ((save-excursion
 621            (beginning-of-line)
 622            (looking-at visual-basic-comment-regexp))
 623          (visual-basic-fill-long-comment))
 624         (t
 625          (visual-basic-indent-defun))))
 626
 627
 628 (defun visual-basic-new-sub ()
 629   "Insert template for a new subroutine.  Repeat to cycle through alternatives."
 630   (interactive)
 631   (beginning-of-line)
 632   (let ((templates (cons visual-basic-blank-regexp
 633                          visual-basic-defn-templates))
 634         (tem nil)
 635         (bound (point)))
 636     (while templates
 637       (setq tem (car templates)
 638             templates (cdr templates))
 639       (cond ((looking-at tem)
 640              (replace-match (or (car templates)
 641                                 ""))
 642              (setq templates nil))))
 643
 644     (search-backward "()" bound t)))
 645
 646
 647 ;; (defun visual-basic-untabify ()
 648 ;;   "Do not allow any tabs into the file."
 649 ;;   (if (eq major-mode 'visual-basic-mode)
 650 ;;       (untabify (point-min) (point-max)))
 651 ;;   nil)
 652
 653 (defun visual-basic-default-tag ()
 654   (if (and (not (bobp))
 655            (save-excursion
 656              (backward-sexp)
 657              (looking-at "\\w")))
 658       (backward-word 1))
 659   (let ((s (point))
 660         (e (save-excursion
 661              (forward-sexp)
 662              (point))))
 663     (buffer-substring s e)))
 664
 665 (defun visual-basic-grep (tag)
 666   "Search BASIC source files in current directory for TAG."
 667   (interactive
 668    (list (let* ((def (visual-basic-default-tag))
 669                 (tag (read-string
 670                       (format "Grep for [%s]: " def))))
 671            (if (string= tag "") def tag))))
 672   (grep (format "grep -n %s %s" tag visual-basic-wild-files)))
 673
 674
 675 ;;; IDE Connection.
 676
 677 (defun visual-basic-buffer-project-file ()
 678   "Return a guess as to the project file associated with the current buffer."
 679   (car (directory-files (file-name-directory (buffer-file-name)) t "\\.vbp")))
 680
 681 (defun visual-basic-start-ide ()
 682   "Start Visual Basic (or your favorite IDE, (after Emacs, of course))
 683 on the first project file in the current directory.
 684 Note: it's not a good idea to leave Visual Basic running while you
 685 are editing in Emacs, since Visual Basic has no provision for reloading
 686 changed files."
 687   (interactive)
 688   (let (file)
 689     (cond ((null visual-basic-ide-pathname)
 690            (error "No pathname set for Visual Basic.  See visual-basic-ide-pathname"))
 691           ((null (setq file (visual-basic-buffer-project-file)))
 692            (error "No project file found"))
 693           ((fboundp 'win-exec)
 694            (iconify-emacs)
 695            (win-exec visual-basic-ide-pathname 'win-show-normal file))
 696           ((fboundp 'start-process)
 697            (iconify-frame (selected-frame))
 698            (start-process "*VisualBasic*" nil visual-basic-ide-pathname file))
 699           (t
 700            (error "No way to spawn process!")))))
 701
 702
 703
 704 ;;; Indentation-related stuff.
 705
 706 (defun visual-basic-indent-region (start end)
 707   "Perform visual-basic-indent-line on each line in region."
 708   (interactive "r")
 709   (save-excursion
 710     (goto-char start)
 711     (beginning-of-line)
 712     (while (and (not (eobp))
 713                 (< (point) end))
 714       (if (not (looking-at visual-basic-blank-regexp))
 715           (visual-basic-indent-line))
 716       (forward-line 1)))
 717
 718   (cond ((fboundp 'zmacs-deactivate-region)
 719          (zmacs-deactivate-region))
 720         ((fboundp 'deactivate-mark)
 721          (deactivate-mark))))
 722
 723
 724
 725 (defun visual-basic-previous-line-of-code ()
 726   (if (not (bobp))
 727       (forward-line -1))        ; previous-line depends on goal column
 728   (while (and (not (bobp))
 729               (or (looking-at visual-basic-blank-regexp)
 730                   (looking-at visual-basic-comment-regexp)))
 731     (forward-line -1)))
 732
 733
 734 (defun visual-basic-find-original-statement ()
 735   "If the current line is a continuation, move back to the original stmt."
 736   (let ((here (point)))
 737     (visual-basic-previous-line-of-code)
 738     (while (and (not (bobp))
 739                 (looking-at visual-basic-continuation-regexp))
 740       (setq here (point))
 741       (visual-basic-previous-line-of-code))
 742     (goto-char here)))
 743
 744 (defun visual-find-matching-stmt (open-p close-p)
 745   ;; Searching backwards
 746   (let ((level 0))
 747     (while (and (>= level 0) (not (bobp)))
 748       (visual-basic-previous-line-of-code)
 749       (visual-basic-find-original-statement)
 750       (cond ((funcall close-p)
 751              (setq level (+ level 1)))
 752             ((funcall open-p)
 753              (setq level (- level 1)))))))
 754
 755 (defun visual-basic-find-matching-stmt (open-regexp close-regexp)
 756   (visual-find-matching-stmt
 757    (lambda () (looking-at open-regexp))
 758    (lambda () (looking-at close-regexp))))
 759
 760 (defun visual-basic-get-complete-tail-of-line ()
 761   "Return the tail of the current statement line, starting at
 762   point and going up to end of statement line. If you want the
 763   complete statement line, you have to call functions
 764   `visual-basic-find-original-statement' and then
 765   `beginning-of-line' before"
 766   (let* ((start-point (point))
 767          complete-line
 768          (line-beg start-point)
 769          line-end)
 770     (while (null line-end)
 771       (end-of-line)
 772       (setq line-end (point))
 773       (if (search-backward "_" line-beg t)
 774           (if (looking-at  visual-basic-looked-at-continuation-regexp)
 775               ;; folded line
 776               (progn
 777                 (setq line-end (1- (point))
 778                       complete-line (cons
 779                                      (buffer-substring-no-properties
 780                                       line-beg line-end)
 781                                      complete-line)
 782                       line-end nil)
 783                 (beginning-of-line 2)
 784                 (setq line-beg (point)))
 785             ;; _ found, but not a folded line (this is a syntax error)
 786             (setq complete-line
 787                   (cons (buffer-substring-no-properties line-beg line-end) complete-line)))
 788         ;; not a folded line
 789         (setq complete-line
 790               (cons (buffer-substring-no-properties line-beg line-end)
 791                     complete-line))))
 792     (mapconcat 'identity (nreverse complete-line) " ")))
 793
 794 (defun visual-basic-if-not-on-single-line ()
 795   "Return non-`nil' when the If statement is not on a single statement
 796 line, i.e. requires a matching End if. Note that a statement line may
 797 be folded over several code lines."
 798   (if (looking-at visual-basic-if-regexp)
 799       (save-excursion
 800         (beginning-of-line)
 801         (let (p1
 802               p2
 803               ;; 1st reconstruct complete line
 804               (complete-line (visual-basic-get-complete-tail-of-line)) )
 805
 806           ;; now complete line has been reconstructed, drop confusing elements
 807
 808           ;; remove any VB string from complete line, as strings may disrupt : and ' detection
 809           (while (and (setq p1 (string-match "\"" complete-line))
 810                       (setq p2 (string-match "\"" complete-line (1+ p1))))
 811             (setq complete-line (concat (substring complete-line 0 p1)
 812                                         (substring complete-line (1+ p2)))))
 813           ;; now drop tailing comment if any
 814           (when (setq p1 (string-match "'" complete-line))
 815             (setq complete-line (substring complete-line p1)))
 816           ;; now drop 1st concatenated instruction is any
 817           (when (setq p1 (string-match ":" complete-line))
 818             (setq complete-line (substring complete-line p1)))
 819           ;;
 820           (string-match "Then\\s-*$" complete-line))); end (save-excursion ...)
 821     ;; else, not a basic if
 822     nil))
 823
 824 (defun visual-basic-find-matching-if ()
 825   (visual-find-matching-stmt 'visual-basic-if-not-on-single-line
 826                                                          (lambda () (looking-at visual-basic-endif-regexp))))
 827
 828 (defun visual-basic-find-matching-select ()
 829   (visual-basic-find-matching-stmt visual-basic-select-regexp
 830                                    visual-basic-select-end-regexp))
 831
 832 (defun visual-basic-find-matching-for ()
 833   (visual-basic-find-matching-stmt visual-basic-for-regexp
 834                                    visual-basic-next-regexp))
 835
 836 (defun visual-basic-find-matching-do ()
 837   (visual-basic-find-matching-stmt visual-basic-do-regexp
 838                                    visual-basic-loop-regexp))
 839
 840 (defun visual-basic-find-matching-while ()
 841   (visual-basic-find-matching-stmt visual-basic-while-regexp
 842                                    visual-basic-wend-regexp))
 843
 844 (defun visual-basic-find-matching-with ()
 845   (visual-basic-find-matching-stmt visual-basic-with-regexp
 846                                    visual-basic-end-with-regexp))
 847
 848 ;;; If this fails it must return the indent of the line preceding the
 849 ;;; end not the first line because end without matching begin is a
 850 ;;; normal simple statement
 851 (defun visual-basic-find-matching-begin ()
 852   (let ((original-point (point)))
 853     (visual-basic-find-matching-stmt visual-basic-begin-regexp
 854                                      visual-basic-end-begin-regexp)
 855     (if (bobp) ;failed to find a matching begin so assume that it is
 856                ;an end statement instead and use the indent of the
 857                ;preceding line.
 858         (progn (goto-char original-point)
 859                (visual-basic-previous-line-of-code)))))
 860
 861
 862 (defun visual-basic-calculate-indent ()
 863   (let ((original-point (point)))
 864     (save-excursion
 865       (beginning-of-line)
 866       ;; Some cases depend only on where we are now.
 867       (cond ((or (looking-at visual-basic-defun-start-regexp)
 868                  (looking-at visual-basic-label-regexp)
 869                  (looking-at visual-basic-defun-end-regexp))
 870              0)
 871
 872             ;; The outdenting stmts, which simply match their original.
 873             ((or (looking-at visual-basic-else-regexp)
 874                  (looking-at visual-basic-endif-regexp))
 875              (visual-basic-find-matching-if)
 876              (current-indentation))
 877
 878             ;; All the other matching pairs act alike.
 879             ((looking-at visual-basic-next-regexp) ; for/next
 880              (visual-basic-find-matching-for)
 881              (current-indentation))
 882
 883             ((looking-at visual-basic-loop-regexp) ; do/loop
 884              (visual-basic-find-matching-do)
 885              (current-indentation))
 886
 887             ((looking-at visual-basic-wend-regexp) ; while/wend
 888              (visual-basic-find-matching-while)
 889              (current-indentation))
 890
 891             ((looking-at visual-basic-end-with-regexp) ; with/end with
 892              (visual-basic-find-matching-with)
 893              (current-indentation))
 894
 895             ((looking-at visual-basic-select-end-regexp) ; select case/end select
 896              (visual-basic-find-matching-select)
 897              (current-indentation))
 898
 899             ;; A case of a select is somewhat special.
 900             ((looking-at visual-basic-case-regexp)
 901              (visual-basic-find-matching-select)
 902              (+ (current-indentation) visual-basic-mode-indent))
 903
 904             ;; Added KJW: Make sure that this comes after the cases
 905             ;; for if..endif, end select because end-regexp will also
 906             ;; match "end select" etc.
 907             ((looking-at visual-basic-end-begin-regexp) ; begin/end
 908              (visual-basic-find-matching-begin)
 909              (current-indentation))
 910
 911             (t
 912              ;; Other cases which depend on the previous line.
 913              (visual-basic-previous-line-of-code)
 914
 915              ;; Skip over label lines, which always have 0 indent.
 916              (while (looking-at visual-basic-label-regexp)
 917                (visual-basic-previous-line-of-code))
 918
 919              (cond
 920               ((looking-at visual-basic-continuation-regexp)
 921                (visual-basic-find-original-statement)
 922                ;; Indent continuation line under matching open paren,
 923                ;; or else one word in.
 924                (let* ((orig-stmt (point))
 925                       (matching-open-paren
 926                        (condition-case ()
 927                            (save-excursion
 928                              (goto-char original-point)
 929                              (beginning-of-line)
 930                              (backward-up-list 1)
 931                              ;; Only if point is now w/in cont. block.
 932                              (if (<= orig-stmt (point))
 933                                  (current-column)))
 934                          (error nil))))
 935                  (cond (matching-open-paren
 936                         (1+ matching-open-paren))
 937                        (t
 938                         ;; Else, after first word on original line.
 939                         (back-to-indentation)
 940                         (forward-word 1)
 941                         (while (looking-at "[ \t]")
 942                           (forward-char 1))
 943                         (current-column)))))
 944               (t
 945                (visual-basic-find-original-statement)
 946
 947                (let ((indent (current-indentation)))
 948                  ;; All the various +indent regexps.
 949                  (cond ((looking-at visual-basic-defun-start-regexp)
 950                         (+ indent visual-basic-mode-indent))
 951
 952                        ((or (visual-basic-if-not-on-single-line)
 953                                                         (and (looking-at visual-basic-else-regexp)
 954                                                                  (not (and visual-basic-allow-single-line-if
 955                                                                                    (looking-at visual-basic-ifthen-regexp)))))
 956                         (+ indent visual-basic-mode-indent))
 957
 958                        ((or (looking-at visual-basic-select-regexp)
 959                             (looking-at visual-basic-case-regexp))
 960                         (+ indent visual-basic-mode-indent))
 961
 962                        ((or (looking-at visual-basic-do-regexp)
 963                             (looking-at visual-basic-for-regexp)
 964                             (looking-at visual-basic-while-regexp)
 965                             (looking-at visual-basic-with-regexp)
 966                             (looking-at visual-basic-begin-regexp))
 967                         (+ indent visual-basic-mode-indent))
 968
 969                        (t
 970                         ;; By default, just copy indent from prev line.
 971                         indent))))))))))
 972
 973 (defun visual-basic-indent-to-column (col)
 974   (let* ((bol (save-excursion
 975                 (beginning-of-line)
 976                 (point)))
 977          (point-in-whitespace
 978           (<= (point) (+ bol (current-indentation))))
 979          (blank-line-p
 980           (save-excursion
 981             (beginning-of-line)
 982             (looking-at visual-basic-blank-regexp))))
 983
 984     (cond ((/= col (current-indentation))
 985            (save-excursion
 986              (beginning-of-line)
 987              (back-to-indentation)
 988              (delete-region bol (point))
 989              (indent-to col))))
 990
 991     ;; If point was in the whitespace, move back-to-indentation.
 992     (cond (blank-line-p
 993            (end-of-line))
 994           (point-in-whitespace
 995            (back-to-indentation)))))
 996
 997
 998 (defun visual-basic-indent-line ()
 999   "Indent current line for BASIC."
1000   (interactive)
1001    (visual-basic-indent-to-column (visual-basic-calculate-indent)))
1002
1003
1004 (defun visual-basic-split-line ()
1005   "Split line at point, adding continuation character or continuing a comment.
1006 In Abbrev mode, any abbrev before point will be expanded."
1007   (interactive)
1008   (let ((pps-list (parse-partial-sexp (save-excursion
1009                                         (beginning-of-line)
1010                                         (point))
1011                                       (point))))
1012     ;; Dispatch on syntax at this position.
1013     (cond ((equal t (nth 4 pps-list))  ; in comment
1014            (indent-new-comment-line))
1015           ((equal t (nth 4 pps-list))   ; in string
1016            (error "Can't break line inside a string"))
1017           (t (just-one-space)           ; leading space on next line
1018                                         ; doesn't count, sigh
1019              (insert "_")
1020              (visual-basic-newline-and-indent)))))
1021
1022 (defun visual-basic-detect-idom ()
1023   "Detects whether this is a VBA or VBS script. Returns symbol
1024   `vba' if it is VBA, `nil' otherwise"
1025   (let (ret)
1026     (save-excursion
1027       (save-restriction
1028         (widen)
1029         (goto-char (point-min))
1030         (cond
1031          ((looking-at "^[ \t]*Attribute\\s-+VB_Name\\s-+= ") (setq ret 'vba)))
1032          ))
1033     ret))
1034
1035 (defun visual-basic-close-block ()
1036   "Insert `End If' is current block is a `If Then ...', `End
1037 With' if the block is a `With ...', etc..."
1038   (interactive)
1039   (let (end-statement end-indent)
1040     (save-excursion
1041       (save-match-data
1042         (while
1043             (unless  (bobp)
1044               (visual-basic-previous-line-of-code)
1045               (visual-basic-find-original-statement)
1046               (cond
1047                ;; Cases where the current statement is a start-of-smthing statement
1048                ((looking-at visual-basic-defun-start-regexp)
1049                 (let ((smt (match-string 2)))
1050                   (when (string-match "\\`Prop" smt)
1051                     (setq smt "Property"))
1052                   (setq end-statement (concat "End " smt)
1053                         end-indent 0))
1054                 nil)
1055                ((looking-at visual-basic-select-regexp)
1056                 (setq  end-statement "End Select"
1057                        end-indent (current-indentation))
1058                 nil)
1059                ((looking-at visual-basic-with-regexp)
1060                 (setq  end-statement "End With"
1061                        end-indent (current-indentation))
1062                 nil)
1063                ((looking-at visual-basic-case-regexp)
1064                 (setq  end-statement  "End Select"
1065                        end-indent (max 0 (- (current-indentation) visual-basic-mode-indent)))
1066                 nil)
1067                ((looking-at visual-basic-begin-regexp)
1068                 (setq  end-statement "End"
1069                        end-indent (current-indentation))
1070                 nil)
1071                ((or (visual-basic-if-not-on-single-line)
1072                     (looking-at visual-basic-else-regexp))
1073                 (setq  end-statement "End If"
1074                        end-indent (current-indentation))
1075                 nil)
1076
1077                ((looking-at visual-basic-do-regexp)
1078                 (setq  end-statement "Loop"
1079                        end-indent (current-indentation))
1080                 nil)
1081
1082                ((looking-at visual-basic-for-regexp)
1083                 (goto-char (match-end 0))
1084                 (setq  end-statement "Next"
1085                        end-indent (current-indentation))
1086                 (let ((vb-idom (visual-basic-detect-idom)))
1087                   (cond
1088                    ;; for VBA add the variable name after Next.
1089                    ((eq vb-idom 'vba)
1090                     (when (looking-at "\\s-+\\(Each\\s-+\\|\\)\\([^ \t\n\r]+\\)")
1091                       (setq end-statement (concat end-statement " " (match-string 2)))))))
1092                 nil)
1093                ;; Cases where the current statement is an end-of-smthing statement
1094                ((or (looking-at visual-basic-else-regexp)
1095                     (looking-at visual-basic-endif-regexp))
1096                 (visual-basic-find-matching-if)
1097                 t)
1098                ((looking-at visual-basic-next-regexp) ; for/next
1099                 (visual-basic-find-matching-for)
1100                 t)
1101                ((looking-at visual-basic-loop-regexp) ; do/loop
1102                 (visual-basic-find-matching-do)
1103                 t)
1104                ((looking-at visual-basic-wend-regexp) ; while/wend
1105                 (visual-basic-find-matching-while)
1106                 t)
1107                ((looking-at visual-basic-end-with-regexp) ; with/end with
1108                 (visual-basic-find-matching-with)
1109                 t)
1110                ((looking-at visual-basic-select-end-regexp) ; select case/end select
1111                 (visual-basic-find-matching-select)
1112                 t)
1113
1114
1115                ;; default is to loop again back to previous line of code.
1116                (t t))))))
1117     (when end-statement
1118       (insert end-statement)
1119       (visual-basic-indent-to-column end-indent))))
1120
1121 (defvar delta-split-to-cur-point) ;; Don't know what it is, just silence compiler
1122
1123 (defun visual-basic-insert-item ()
1124   "Insert a new item in a block.
1125
1126 This function is under developement, and for the time being only Dim items are handled.
1127
1128 Interting an item means:
1129
1130 * Add a `Case' or `Case Else' into a `Select ... End Select'
1131   block. Pressing again toggles between `Case' and `Case
1132   Else'. `Case Else' is possible only if there is not already a `Case Else'.
1133
1134 * split a Dim declaration over several lines.
1135
1136 * Add an `Else' or `ElseIf ... Then' into an `If ... Then ... End
1137   If' block. Pressing again toggles between `Else' and `ElseIf
1138   ... Then'. `Else' is possible only if therei s not already an
1139   `Else'.
1140 "
1141   (interactive)
1142   ;; possible cases are
1143   ;; dim-split-before => split before variable name
1144   ;; dim-split-after => split after type name if any
1145   ;; if-with-else
1146   ;; if-without-else
1147   ;; select-with-else
1148   ;; select-without-else
1149   ;; not-itemizable
1150   (let (item-case
1151         item-ident
1152         split-point
1153         cur-point-mark
1154         prefix
1155         tentative-split-point
1156         block-stack (cur-point (point)) previous-line-of-code)
1157     (save-excursion
1158       (save-match-data
1159         (beginning-of-line)
1160         (while
1161             (progn
1162               (visual-basic-find-original-statement)
1163               (cond
1164                ;; dim case
1165                ;;--------------------------------------------------------------
1166                ((and (null previous-line-of-code)
1167                      (looking-at visual-basic-dim-regexp)
1168                      (null (save-match-data (looking-at visual-basic-defun-start-regexp))))
1169                 (setq prefix (buffer-substring-no-properties
1170                               (point)
1171                               (goto-char (setq split-point (match-end 0)))))
1172                 (while
1173                     (progn
1174                       (if
1175                           (looking-at "\\s-*\\sw+\\s-*")
1176                           (progn
1177                             (goto-char (setq tentative-split-point (match-end 0)))
1178                             (if (>= tentative-split-point cur-point)
1179                                   nil
1180                               (while (or
1181                                       (looking-at "([^)\n]+)\\s-*")
1182                                       (looking-at visual-basic-looked-at-continuation-regexp))
1183                                 (goto-char (setq tentative-split-point (match-end 0))))
1184                               (when (looking-at "As\\s-+\\sw+\\s-*")
1185                                 (goto-char (setq tentative-split-point (match-end 0))))
1186                               (when (looking-at visual-basic-looked-at-continuation-regexp)
1187                                 (beginning-of-line 2))
1188                               (if (looking-at ",")
1189                                   (goto-char (setq split-point (match-end 0)))
1190                                 (setq split-point (point))
1191                                 nil)))
1192                         nil)))
1193                 (goto-char split-point)
1194                 (setq item-case (if (<= split-point cur-point) 'dim-split-before 'dim-split-after))
1195                 (setq delta-split-to-cur-point (- split-point cur-point))
1196                 (setq cur-point-mark (make-marker))
1197                 (set-marker cur-point-mark cur-point)
1198                 (looking-at "\\s-*")
1199                 (setq delta-split-to-cur-point (- delta-split-to-cur-point
1200                                                   (- (match-end 0) (match-beginning 0))))
1201                 (delete-region (point) (match-end 0))
1202                 (when (looking-back ",")
1203                   (delete-region split-point (1- split-point)))
1204                 (insert "\n" prefix " ")
1205                 (setq cur-point (marker-position cur-point-mark))
1206                 (set-marker cur-point-mark nil)
1207                 nil)
1208                ;; next
1209                ((looking-at visual-basic-next-regexp)
1210                 (push (list 'next) block-stack))
1211                ;; default
1212                ;;--------------------------------------------------------------
1213                (t (if (bobp)
1214                       (setq item-case 'not-itemizable)))
1215                )
1216               (when (null item-case)
1217                 (visual-basic-previous-line-of-code)
1218                 (setq previous-line-of-code t))
1219               (null item-case)))))
1220     (cond
1221      ((eq item-case 'dim-split-after)
1222       (goto-char cur-point))
1223     )
1224     ))
1225
1226 ;;; Some experimental functions
1227
1228 ;;; Load associated files listed in the file local variables block
1229 (defun visual-basic-load-associated-files ()
1230   "Load files that are useful to have around when editing the source of the file that has just been loaded.
1231 The file must have a local variable that lists the files to be loaded.
1232 If the file name is relative it is relative to the directory
1233 containing the current buffer.  If the file is already loaded nothing
1234 happens, this prevents circular references causing trouble.  After an
1235 associated file is loaded its associated files list will be
1236 processed."
1237   (if (boundp 'visual-basic-associated-files)
1238       (let ((files visual-basic-associated-files)
1239             (file nil))
1240         (while files
1241           (setq file (car files)
1242                 files (cdr files))
1243           (message "Load associated file: %s" file)
1244           (visual-basic-load-file-ifnotloaded file default-directory)))))
1245
1246
1247
1248 (defun visual-basic-load-file-ifnotloaded (file default-directory)
1249   "Load file if not already loaded.
1250 If file is relative then default-directory provides the path"
1251   (let((file-absolute (expand-file-name file default-directory)))
1252     (if (get-file-buffer file-absolute); don't do anything if the buffer is already loaded
1253         ()
1254       (find-file-noselect file-absolute ))))
1255
1256
1257
1258 ;;; visual-basic-mode.el ends here
1259
1260
1261 ;External Links
1262 ;* [http://visualbasic.freetutes.com/ Visual Basic tutorials]
1263