rc/xemacs/visual-basic-mode.el

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