;; gsl-mode.el --- A mode for editing GSharp scripts
;;
;; Installation instructions
;; put gsl-mode.el where it will be found by your emacs loadpath
;; Add the following to your .emacs file
;;  (autoload 'gsl-mode "gsl-mode" "GSL mode." t)
;;  (setq auto-mode-alist (cons '("\\.\\(gsl\\|gsa\\|gsw\\)$" . gsl-mode)
;;                            auto-mode-alist))
;;
;; If you want to change any of the defaults add them via gsl-mode-hook
;;
;;(setq gsl-mode-hook
;;     ( function (lambda ()
;;	   (setq gsl-mode-indent 2)         ;; default 4
;;                (setq gsl-fontify-p nil)  ;; default t
;;                (hilit-highlight-buffer)  ;; if you prefer hilit to font-lock
;; )))
;; To use hilit-mode you will also need to add the two sections of code from 
;; gsl-hilit.el to hilit19.el 
;; You can change the colours used either there, or in your .emacs file
;; (where you use something like (hilit-translate gsfunc2 'cyan)
(provide 'gsl-mode)

;(defvar gsl-xemacs-p (string-match "XEmacs\\|Lucid" (emacs-version)))
;(defvar gsl-winemacs-p (string-match "Win-Emacs" (emacs-version)))

;; Variables you may want to customize.
(defvar gsl-mode-indent 2 "*Default indentation per nesting level")
(defvar gsl-fontify-p t "*Whether to fontify GSL buffers.")
(defvar gsl-wild-files "*.gsl *.gsa *.gsw" "*Wildcard pattern for GSL source files")

(defvar gsl-mode-syntax-table nil)
(if gsl-mode-syntax-table
    ()
  (setq gsl-mode-syntax-table (make-syntax-table))
   ;; /* */ style comments
  (modify-syntax-entry ?/  ". 14" gsl-mode-syntax-table)
  (modify-syntax-entry ?* ". 23b" gsl-mode-syntax-table)
  ;;  Comments starting with #
  (modify-syntax-entry ?\# "<" gsl-mode-syntax-table) ; Comment starter
  (modify-syntax-entry ?\n ">" gsl-mode-syntax-table) ; end of comment

  )


(defvar gsl-mode-map nil)
(if gsl-mode-map
    ()
  (setq gsl-mode-map (make-sparse-keymap))
  (define-key gsl-mode-map "\t" 'gsl-indent-line)
  (define-key gsl-mode-map "\r" 'gsl-newline-and-indent)
  (define-key gsl-mode-map "\M-\C-a" 'gsl-beginning-of-defun)
  (define-key gsl-mode-map "\M-\C-e" 'gsl-end-of-defun)
  (define-key gsl-mode-map "\M-\C-h" 'gsl-mark-defun)
  (define-key gsl-mode-map "\M-\C-\\" 'gsl-indent-region)
  (define-key gsl-mode-map "\M-q" 'gsl-fill-or-indent))

(defvar gsl-font-lock-keywords
  '(("[ \n\t]\\(and\\|break\\|const\\|continue\\|create\\|date\\|destroy\\|elif\\|else\\|endfor\\|endfunction\\|endif\\|endwhile\\|false\\|float\\|for\\|function\\|if\\|include\\|in\\|not\\|or\\|pi\\|print\\|quit\\|repaint\\|return\\|scope\\|set\\|step\\|stop\\|string\\|then\\|time\\|today\\|to\\|true\\|undef\\|while\\)" . 'font-lock-keyword-face)
    ("[ \n\t]\\(Arrow\\|Axis\\|Bulletin\\|Button\\|Canvas\\|Command\\|Dialog\\|Domain\\|Folder\\|Graph\\|Icon\\|Label\\|Legend\\|Logo\\|Menu\\|Menubar\\|Note\\|Page\\|Panel\\|Popup\\|Separator\\|Switch\\|Text\\|Title\\|Toolbar\\|Viewport\\|XuN[a-zA-Z]*\\)" . 'font-lock-builtin-face)
    ("[ \n\t]\\(GuiFileOpen\\|GuiFileSave\\|GuiFilePrintSetup\\|GuiFilePrint\\|GuiFileResetAll\\|GuiFileExit\\|GuiHelp\\|GuiCreateObject\\|GuiEditCut\\|GuiEditCopy\\|GuiEditPaste\\|GuiEditTemplate\\|GuiEditColors\\|GuiEditShades\\|GuiEditLines\\|GuiEditText\\|GuiEditFrames\\|GuiDeleteSelected\\|GuiViewRepaint\\|GuiViewReset\\|GuiOptionsText\\|GuiOptionsSnapGrid\\|GuiToolsDatapool\\|GuiToolsBrowser\\|GuiToolsProgramEditor\\|GuiToolsFunctionEditor\\|GuiPopupDialog\\|GuiPopdownDialog\\|GuiGetString\\|GuiSetString\\|GuiStopIcon\\|GuiResetStopIcon\\|GuiClipboardDropSite\\|GuiTrashcanDropSite\\|GuiViewportDropSite\\|GuiGroupDropSite\\|GuiAddGraphPopupCB\\|GuiGraphDropSite\\|GuiTitleDropSite\\|GuiNoteDropSite\\|GuiArrowDropSite\\|GuiLogoDropSite\\|GuiShowClipboard\\|GuiShowTrashcan\\|GuiCopyClipboard\\|PasteFromExcel\\|GuiSwitchGetState\\|GuiSwitchSetState\\|GuiAutoRepaint\\|GuiAutoRepaintOnDataChanged\\|GuiGraphPicking\\|GuiAutoApply\\|GuiAutoSave\\|GuiSnapRadius\\|GuiCommandClear\\|GuiMessageClear\\|GuiCommandLogging\\|GuiMessageLogging\\|GuiSetDeleteSelectedId\\|GuiDestroyDeleteSelectedId\\|GuiSetAutoRepaintId\\|GuiSetAutoRepaintOnDataChangedId\\|GuiDestroyAutoRepaintId\\|GuiDestroyAutoRepaintOnDataChangedId\\|GuiSetGraphPickingId\\|GuiDestroyGraphPickingId\\|GuiSetAutoApplyId\\|GuiDestroyAutoApplyId\\|GuiSetCommandToolbarId\\|GuiSetObjectToolbarId\\|GuiSetCommandLoggingId\\|GuiDestroyCommandLoggingId\\|GuiSetMessageLoggingId\\|GuiDestroyMessageLoggingId\\|GuiDestroyObjectToolbar\\|GuiDestroyCommandToolbar\\|Gui3DRotate\\|setsensitive\\|GuiPageClear\\|GuiCommandLineRedraw\\|GuiCommandLog\\|GuiLogCommand\\|GuiImagePrintDlg\\|GuiGetAllString\\|GuiHTMLHelp\\|GuiCheckDialog\\|GuiPageEditor\\|GuiViewportEditor\\|GuiArrowEditor\\|GuiNoteEditor\\|GuiLogoEditor\\|GuiLegendEditor\\|GuiGraphEditor\\|GuiTitleEditor\\|GuiAxisEditor\\|GuiDomainEditor\\|GuiSnapGridEditor\\|GuiTextOptEditor\\|GuiLineEditor\\|GuiTextEditor\\|GuiWarning\\|GuiSelectInterface\\|ShowObjectEditor\\|CanvasCB\\|GuiGraphPickingNew\\|DeleteObject\\|GuiDeleteObject\\|GuiDeleteCB\\|GuiEditObject\\|GuiEditCB\\|GuiEditSelected\\|GuiPageSetup\\|GuiImagePrintSetup\\|GuiOptionsInterface\\|WindowLayoutCB\\|GuiCreateObjects\\|GuiCreateIcons\\|GuiPack\\|GuiUnpack\\|GuiWarn\\|GuiInfo\\|GuiQuestion\\|GuiMultiline\\|GuiEchoCB\\|GuiEvalCB\\|GuiExecCB\\|GuiPopupCB\\|GuiPopdownCB\\|GuiDestroyCB\\|GuiPopupDialogCB\\|GuiPopdownDialogCB\\|GuiSetCanvasCallback\\|GuiShowSelectionCB\\|GuiSelectionMadeCB\\|GuiShowExample\\|ObjChildProtection\\|ObjBranchOf\\|ObjNewPathName\\|ObjPathCreate\\|ObjResourceEnumerateds\\|ObjTupleStrValue\\|ObjTupleValueStr\\|ObjTemplateName\\|ObjShortName\\|ObjNewName\\|ObjParent\\|ObjParentOfClass\\|ObjChildrenOfClass\\|ObjFindChild\\|ObjChildren\\|ObjFramesEnabled\\|ObjClasses\\|ObjBundleResources\\|ObjResourceBundles\\|ObjMultiMatch\\|ObjResourceValueString\\|XuClosestColor\\|XuTokenize\\|XuMsg\\|XuTrace\\|XuTuple2Str\\|XuGetArg\\|XuMaxDayNumber\\|XuIndexOf\\|XuSwap\\|XuWorkboxToMM\\|XuWorkboxToWorld\\|XuWorldToWorkbox\\|XuPercentWidth\\|XuPercentHeight\\|XuRelativeMM\\|XuFileList\\|XuUNIXFileList\\|XuWindowsFileList\\|XuVMSFileList\\|XuReadTextLines\\|XuReadTextFile\\|XuReadHTTPFile\\|XuWriteTextFile\\|XuTextReplace\\|XuBasename\\|GuiZoom_\\|GuiZoom\\|GuiZoomIn\\|GuiZoomOut\\|GuiZoomFactor\\|GuiZoomInit\\|GuiZoomRestore\\|GuiZoomUndo\\|GuiCreateMenubar\\|GuiCreateFileMenu\\|GuiCreateCreateMenu\\|GuiCreateTemplateMenu\\|GuiCreateEditMenu\\|GuiCreateDeleteMenu\\|GuiCreateViewMenu\\|GuiCreateOptionsMenu\\|GuiCreateToolsMenu\\|GuiCreateExampleMenu\\|GuiCreateCommandToolbar\\|GuiCreateCanvas\\|GuiCreateObjectToolbar\\|GuiCreateCommandLine\\|GuiCreateHelpMenu\\|GuiDefineDevices\\)" . 'font-lock-type-face)
    ("[ \n\t]\\(bounding_polygon\\|all\\|getresources\\|getenums\\|getunit\\|use_library\\|dbopt\\|append\\|count\\|countx\\|dropx\\|dropy\\|dropz\\|if\\|list\\|mask\\|redim\\|repeatx\\|repeaty\\|repeatz\\|reshape\\|reverse\\|sizex\\|sizey\\|sizez\\|size\\|slicex\\|slicey\\|slicez\\|slice\\|dateformat1\\|daynumber\\|dayrange\\|daysince\\|hournumber\\|hourrange\\|invdaysince\\|invsecsince\\|middayrange\\|midhourrange\\|midminuterange\\|midmonthrange\\|midquarterrange\\|midsecondrange\\|midweekrange\\|midyearrange\\|minutenumber\\|minuterange\\|monthnumber\\|monthrange\\|quarternumber\\|quarterrange\\|secondnumber\\|secondrange\\|secsince\\|timeformat1\\|todate\\|totime\\|weekday\\|weeknumber\\|weekrange\\|yearnumber\\|yearrange\\|abs\\|acos\\|accum\\|and\\|asin\\|atan\\|atan2\\|avg\\|avgx\\|cos\\|cosh\\|crosssum\\|crosstable\\|diff\\|differentiate\\|div\\|exp\\|exprnd\\|fact\\|fftabs\\|fftimag\\|fftcos\\|fftreal\\|fftsin\\|fprob\\|histogram\\|histosum\\|int\\|integrate\\|invfftimag\\|invfftreal\\|ln\\|log\\|log10\\|matdet\\|matinv\\|matmul\\|matsolve\\|max\\|max2\\|maxx\\|min\\|min2\\|minx\\|mod\\|moveavg\\|movesum\\|nicerange\\|nint\\|normprob\\|normrnd\\|not\\|or\\|range\\|rnd\\|round\\|seed\\|set_undef\\|sign\\|sin\\|sinh\\|sqrt\\|std\\|std1\\|std1x\\|stdx\\|step\\|step2\\|sum\\|sumx\\|tan\\|tanh\\|tprob\\|transpose\\|trunc\\|x2prob\\|bilinear\\|fault\\|polynomial\\|bivariate\\|expsemiv\\|krig2d\\|lags\\|linsemiv\\|polyfit\\|ransemiv\\|regular\\|smooth\\|sphsemiv\\|spline\\|xpmsemiv\\|export_ascii\\|export_binary\\|export_report\\|export_folder\\|import_ascii\\|import_field\\|import_binary\\|import_report\\|import_folder\\|import_csv\\|match\\|sprintf\\|strchr\\|strrchr\\|strlen\\|strstr\\|strvalue\\|substr\\|tokenize\\|tolower\\|tostring\\|toupper\\|tovalue\\|valuestr\\|convjp\\|nlsmsg\\|sortby\\|sort\\|unique\\|proj_coord\\|proj_false\\|proj_origin\\|proj_parallels\\|proj_scale_factor\\|proj_spheroid\\|proj_spheroid_select\\|proj_transform\\|proj_type\\|proj_unit\\|proj_utm_zone\\|batch\\|appseat\\|webedition\\|current_folder\\|current_object\\|define_device\\|echo\\|eval\\|exec\\|generate_gsl\\|getdir\\|getpid\\|member\\|message_level\\|set_messages\\|get_messages\\|namelist\\|filelist\\|nargs\\|pause\\|quit\\|printf\\|setdir\\|system\\|tmpnam\\|version\\|os_type\\|input_float\\|input_string\\|input_file\\|input_selection\\|input_dataset\\|beep\\|fopen\\|fflush\\|fclose\\|ftell\\|fseek\\|fread\\|fwrite\\|fprintf\\|rename\\|remove\\|import_worldmap\\|showcode\\|showcountry\\|getcountry\\|getcode\\|getenv\\|putenv\\)" . 'font-lock-function-name-face)))
;; These abbrevs are valid only in a code context.
(defvar gsl-mode-abbrev-table nil)

(defvar gsl-mode-hook ())

(defconst gsl-defun-start-regexp
  "^[ \t]*function[ \t]*(?")
(defconst gsl-defun-end-regexp
  "^[ \t]*endfunction")
(defconst gsl-for-start-regexp
  "^[ \t]*for[ \t(]")
(defconst gsl-for-end-regexp
  "^[ \t]*endfor")
(defconst gsl-while-start-regexp
  "^[ \t]*while[ \t(]")
(defconst gsl-while-end-regexp
  "^[ \t]*endwhile")

(defconst gsl-blank-regexp "^[ \t]*$")
(defconst gsl-comment-regexp "/\\*")
(defconst gsl-comment-start-regexp ".*/\\*")
(defconst gsl-comment-end-regexp ".*\\*/")
(defconst gsl-comment-cont-regexp "^[ \t]*\*")

(defconst gsl-if-regexp "^[ \t]*if")
(defconst gsl-else-regexp "^[ \t]*\\(else\\|elif\\)")
(defconst gsl-endif-regexp "^[ \t]*endif")


(defun gsl-mode ()
  "A mode for editing GSharp scripts.
Features automatic  indentation and highlighting using font-lock.
Commands:
\\{gsl-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map gsl-mode-map)
  (setq major-mode 'gsl-mode)
  (setq mode-name "GSL")
  (set-syntax-table gsl-mode-syntax-table)
  
  (add-hook 'write-file-hooks 'gsl-untabify)
  
  (setq local-abbrev-table gsl-mode-abbrev-table)
  
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'gsl-indent-line)
  
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(gsl-font-lock-keywords nil nil))

  (if gsl-fontify-p
      (font-lock-mode 1))
  (run-hooks 'gsl-mode-hook))


(defun gsl-newline-and-indent (&optional count)
  "Insert a newline, updating indentation."
  (interactive)
  (expand-abbrev)
  (gsl-indent-line)
  (call-interactively 'newline-and-indent)
)

(defun gsl-beginning-of-defun ()
  (interactive)
  (re-search-backward gsl-defun-start-regexp))

(defun gsl-end-of-defun ()
  (interactive)
  (re-search-forward gsl-defun-end-regexp))

(defun gsl-mark-defun ()
  (interactive)
  (beginning-of-line)
  (gsl-end-of-defun)
  (set-mark (point))
  (gsl-beginning-of-defun)
)
  
(defun gsl-indent-defun ()
  (interactive)
  (save-excursion
    (gsl-mark-defun)
    (call-interactively 'gsl-indent-region)))


(defun gsl-fill-long-comment ()
  "Fills block of comment lines around point."
  ;; Derived from code in ilisp-ext.el.
  (interactive)
  (save-excursion
    (beginning-of-line)
    (let ((comment-re "^[ \t]*\\s<+[ \t]*"))
      (if (looking-at comment-re)
	  (let ((fill-prefix
		 (buffer-substring
		  (progn (beginning-of-line) (point))
		  (match-end 0))))

	    (while (and (not (bobp))
			(looking-at gsl-comment-regexp))
	      (forward-line -1))
	    (if (not (bobp)) (forward-line 1))

	    (let ((start (point)))
	      
	      ;; Make all the line prefixes the same.
	      (while (and (not (eobp))
			  (looking-at comment-re))
		(replace-match fill-prefix)
		(forward-line 1))
	      
	      (if (not (eobp))
		  (beginning-of-line))
	      
	      ;; Fill using fill-prefix
	      (fill-region-as-paragraph start (point))))))))


(defun gsl-fill-or-indent ()
  "Fill long comment around point, if any, else indent current definition."
  (interactive)
  (cond ((save-excursion
	   (beginning-of-line)
	   (looking-at gsl-comment-regexp))
	 (gsl-fill-long-comment))
	(t
	 (gsl-indent-defun))))



(defun gsl-untabify ()
  "Do not allow any tabs into the file"
  (if (eq major-mode 'gsl-mode)
      (untabify (point-min) (point-max)))
  nil)

(defun gsl-default-tag ()
  (if (and (not (bobp))
	   (save-excursion
	     (backward-char 1)
	     (looking-at "\\w")))
      (backward-word 1))
  (let ((s (point))
	(e (save-excursion
	     (forward-word 1)
	     (point))))
    (buffer-substring s e)))

(defun gsl-grep (tag)
  "Search GSL source files in current directory for tag.
(May complain if you don't have at least one file of each type listed in 
gsl-wild-files in the current directory)"
  (interactive
   (list (let* ((def (gsl-default-tag))
		(tag (read-string
		      (format "Grep for [%s]: " def))))
	   (if (string= tag "") def tag))))
  
  (grep (format "grep -n %s %s" tag gsl-wild-files)))


(defun gsl-indent-region (start end)
  "Perform gsl-indent-line on each line in region."
  (interactive "r")
  (save-excursion
    (goto-char start)
    (beginning-of-line)
    (while (and (not (eobp))
		(< (point) end))
      (if (not (looking-at gsl-blank-regexp))
	  (gsl-indent-line))
      (forward-line 1)))
)



(defun gsl-previous-line-of-code ()
  (if (not (bobp))
      (forward-line -1))	; previous-line depends on goal column
  (while (and (not (bobp))
	      (looking-at gsl-blank-regexp))
    (forward-line -1)))


(defun gsl-find-original-statement ()
  ;; If the current line is a continuation from the previous, move
  ;; back to the original stmt.
  (let ((here (point)))
    (gsl-previous-line-of-code)
    (goto-char here)))

(defun gsl-find-matching-stmt (open-regexp close-regexp)
  ;; Searching backwards
  (let ((level 0))
    (while (and (>= level 0) (not (bobp)))
      (gsl-previous-line-of-code)
      (gsl-find-original-statement)
      (cond ((looking-at close-regexp)
	     (setq level (+ level 1)))
	    ((looking-at open-regexp)
	     (setq level (- level 1)))))))

(defun gsl-find-matching-if ()
  (gsl-find-matching-stmt gsl-if-regexp gsl-endif-regexp))


(defun gsl-find-matching-for ()
  (gsl-find-matching-stmt gsl-for-start-regexp gsl-for-end-regexp))

(defun gsl-find-matching-while ()
  (gsl-find-matching-stmt gsl-while-start-regexp gsl-while-end-regexp))


(defun gsl-calculate-indent ()
  (let ((original-point (point)))
    (save-excursion
      (beginning-of-line)
      ;; Some cases depend only on where we are now.
      (cond ((or (looking-at gsl-defun-start-regexp)
		 (looking-at gsl-defun-end-regexp))
	     0)
	    
	    ;; The outdenting stmts, which simply match their original.
	    ((or (looking-at gsl-else-regexp)
		 (looking-at gsl-endif-regexp))
	     (gsl-find-matching-if)
	     (current-indentation))
	    
	    ((looking-at gsl-for-end-regexp) ; for/endfor
	     (gsl-find-matching-for)
	     (current-indentation))
	    
	    ((looking-at gsl-while-end-regexp) ; while/endwhile
	     (gsl-find-matching-while)
	     (current-indentation))
	    (t
	     ;; Other cases which depend on the previous line.
	     (gsl-previous-line-of-code)
	     (gsl-find-original-statement)
	     (let ((indent (current-indentation)))
	       ;; All the various +indent regexps.
	       (cond ((looking-at gsl-defun-start-regexp)
		      (+ indent gsl-mode-indent) )
		     
		     ((or (looking-at gsl-if-regexp)
			  (looking-at gsl-else-regexp))
		      (+ indent gsl-mode-indent))
		     
		     ((or (looking-at gsl-for-start-regexp)
			  (looking-at gsl-while-start-regexp))
		      (+ indent gsl-mode-indent))
		     
		     ((and (looking-at gsl-comment-start-regexp)
			   (not(looking-at gsl-comment-end-regexp)))
		      ;; we are on the second line of a multi-line comment
		      (+ indent 1))
		      ;; we are just below a multi-line comment
		     ((and (looking-at gsl-comment-end-regexp)
			   (not(looking-at gsl-comment-start-regexp)))
		      (+ indent -1))
		     (t
		      ;; By default, just copy indent from prev line.
		      indent))))))))

(defun gsl-indent-to-column (col)
  (let* ((bol (save-excursion
		(beginning-of-line)
		(point)))
	 (point-in-whitespace
	  (<= (point) (current-indentation)))
;	  (<= (point) (+ bol (current-indentation))))
	 (blank-line-p
	  (save-excursion
	    (beginning-of-line)
	    (looking-at gsl-blank-regexp))))
    
    (cond ((/= col (current-indentation))
	   (save-excursion
	     (beginning-of-line)
	     (back-to-indentation)
	     (delete-region bol (point))
	     (indent-to col))))
    
    ;; If point was in the whitespace, move back-to-indentation.
    (cond (blank-line-p
	   (end-of-line))
	  (point-in-whitespace
	   (back-to-indentation)))))


(defun gsl-indent-line ()
  "Indent current line for GSL"
  (interactive)
  (gsl-indent-to-column (gsl-calculate-indent)))