;;; GAMS.EL --- Major mode for editing GAMS program files. ;; Copyright (C) 2001-2008 Shiro Takeda ;; Version: 2.5.4 ;; $Id: gams.el,v 1.17 2008/12/06 21:00:52 st Exp $ ;; Time-stamp: <2008-12-07 06:00:18 Shiro Takeda> ;; Author: Shiro Takeda ;; Maintainer: Shiro Takeda ;; First Created: Sun Aug 19, 2001 12:48 PM ;; This file is not part of any Emacs. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; A copy of the GNU General Public License can be obtained from this ;; program's author or from the Free Software Foundation, ;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; ;; See README file! ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Code starts here. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-and-compile (require 'easymenu)) ;; From cl.el. (unless (fboundp 'oddp) (defun oddp (x) "T if INTEGER is odd." (eq (logand x 1) 1))) (unless (fboundp 'evenp) (defun evenp (x) "T if INTEGER is even." (eq (logand x 1) 0))) (unless (fboundp 'list-length) (defun list-length (x) "Return the length of a list. Return nil if list is circular." (let ((n 0) (fast x) (slow x)) (while (and (cdr fast) (not (and (eq fast slow) (> n 0)))) (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) (if fast (if (cdr fast) nil (1+ n)) n)))) ;; (eval-and-compile ;; If customize isn't available just use defvar instead. (unless (fboundp 'defgroup) (defmacro defgroup (&rest rest) nil) (defmacro defcustom (symbol init docstring &rest rest) `(defvar ,symbol ,init ,docstring))) ;; If `line-beginning-position' isn't available provide one. (unless (fboundp 'line-beginning-position) (defun line-beginning-position (&optional n) "Return the `point' of the beginning of the current line." (save-excursion (beginning-of-line n) (point)))) ;; If `line-end-position' isn't available provide one. (unless (fboundp 'line-end-position) (defun line-end-position (&optional n) "Return the `point' of the end of the current line." (save-excursion (end-of-line n) (point)))) ) ;; eval-and-compile ends. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Define variables. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst gams-mode-version "2.5.4" "Version of GAMS mode.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Define customizable variables. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; Define groups. (defgroup gams nil "Group of GAMS mode for Emacs." :group 'applications) (defgroup gams-faces nil "Group of faces for GAMS mode." :group 'gams :group 'faces) (defgroup gams-keys nil "Group of keybindings for GAMS mode." :group 'gams :group 'keyboard) ;;;;; Customizable variables start here. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables for GAMS mode. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom gams:process-command-name "gams" "*GAMS program file name. If you do not include the GAMS system directory in PATH environmental variable, you must set the full path to GAMS in this variable like \"c:/GAMS20.0/gams.exe.\"." :type 'file :group 'gams) (defcustom gams:process-command-option "ll=0 lo=3 pw=90 ps=9999" "*The command line options passed to GAMS. If you are NTEmacs user, lo=3 option is necessary to show the GAMS process." :type 'string :group 'gams) (defcustom gams-statement-file "~/.gams-statement" "*The name of the file in which user specific statements are stored. If you register new statements and dollar control options, they are saved in the file specified by this variable." :type 'file :group 'gams) (defcustom gams-system-directory "c:/GAMS20.0/" "*The GAMS system directory (the directory where GAMS is installed). This must be assigned the proper value if you want to use `gams-view-docs' and `gams-modlib'." :type 'file :group 'gams) (defcustom gams-statement-upcase nil "*Non-nil means that statement is inserted in upper case. If you want to use lower case, set nil to this variable." :type 'boolean :group 'gams) (defcustom gams-dollar-control-upcase nil "*Non-nil means that dollar control option is inserted in upper case. If you want to use lower case, set nil to this variable." :type 'boolean :group 'gams) (defcustom gams-use-mpsge nil "*If you use MPSGE, set non-nil to this variable." :type 'boolean :group 'gams) (defcustom gams-fill-column 74 "*The column number used for fill-paragraph and auto-fill-mode." :type 'integer :group 'gams) (defcustom gams-recenter-font-lock nil "*If non-nil, font-lock-fontify-block when recentering. If your computer is slow, you may better set this to nil." :type 'boolean :group 'gams) (defcustom gams-file-extension '("gms") "*List of gams program file extensions. If you open a file with an extension included in this list, GAMS mode starts automatically. It doen't matter whether upper case or lower case. For example, (setq gams-file-extension '(\"gms\" \"dat\")) " :type '(repeat (string :tag "value")) :group 'gams) (defcustom gams-multi-process t "*Non-nil enables multiple GAMS processes. Non-nil means that you can run multiple GAMS processes at the same time in an Emacs. If you rarely run multiple processes, you had better set it to nil." :type 'boolean :group 'gams) (defcustom gams-mode-hook nil "*Hook run when gams-mode starts." :type 'hook :group 'gams) ;; from yatex.el (defcustom gams-close-paren-always t "*Non-nil means that close parenthesis when you type `('." :type 'boolean :group 'gams) (defcustom gams-close-double-quotation-always t "*Non-nil means that close double quotation when you type `\"'." :type 'boolean :group 'gams) (defcustom gams-close-single-quotation-always nil "*Non-nil means that close quotation when you type `''." :type 'boolean :group 'gams) (defcustom gams-statement-name "set" "*The initial value of statement insertion." :type 'string :group 'gams) (defcustom gams-dollar-control-name "title" "*The initial value of dollar control insertion." :type 'string :group 'gams) (defcustom gams-user-comment " *------------------------------------------------------------------------ * % *------------------------------------------------------------------------ " "*User defined comment template. You can insert the comment template defined in this variable by executing `gams-insert-comment'. `%' in the string indicates the cursor place and will disappear after template insertion. NB: If you want to include double quoatations and backslashes in this variable, plese escape them with a slash \." :type 'string :group 'gams) (defcustom gams-comment-column 40 "*The default value of `comment-column' in GAMS mode." :type 'integer :group 'gams) (defcustom gams-inlinecom-symbol-start-default "{" "*The default value for the inline comment start symbol. You can insert the inline comment with `gams-comment-dwim-inline'." :type 'string :group 'gams) (defcustom gams-inlinecom-symbol-end-default "}" "*The default value for the inline comment end symbol. You can insert the inline comment with `gams-comment-dwim-inline'." :type 'string :group 'gams) (defcustom gams-eolcom-symbol-default "#" "*The default value for the end-of-line comment symbol. You can insert the inline comment with `gams-comment-dwim'." :type 'string :group 'gams) ;;; from epolib.el (defcustom gams-default-pop-window-height 10 "*The default GAMS process buffer height. If integer, sets the window-height of process buffer. If string, sets the percentage of it. If nil, use default pop-to-buffer." :type 'integer :group 'gams) (defcustom gams-docs-view-program "c:/Program Files/Adobe/Acrobat 5.0/Reader/AcroRd32.exe" "*The name of (or path to) the manual file viewer. Normally, set the PDF file viewer to this variable. GAMS ver.22 includes not only PDF manuals but also manuals of windows help file (CHM file). If you want to view such CHM files, use the program such as cygstart.exe and fiber.exe instead of PDF file viewer." :type 'file :group 'gams) (defcustom gams-docs-directory (concat (file-name-as-directory gams-system-directory) "docs") "*The GAMS document directory. By default, it is set to `gams-system-directory' + docs." :type 'file :group 'gams) (defcustom gams-insert-dollar-control-on nil "*Non-nil means that $ key is binded to inserting dollar control options. If nil, $ key is binded to inserting dollar itself." :group 'gams :type 'boolean) ;;; New variable. (defcustom gams-always-popup-process-buffer t "*Non-nil means popup always the GAMS process buffer when you run GAMS. If nil, the GAMS process buffer does not popup unless you type `C-cC-l'." :type 'boolean :group 'gams) (defcustom gams-sd-included-file t "If non-nil, `gams-show-identifier-defintion' searches the identifier definition also in the files included through $include or $batinclude. If nil, search the identifier definition only in the current files." :type 'boolean :group 'gams) ;; (defcustom gams-distrbution-version "21.2" ;; "Version number of GAMS distribution." ;; :type 'number ;; :group 'gams) ;; (defvar gams-dist-20 (string-match "20" gams-distrbution-version)) ;; (defvar gams-dist-21 (string-match "21" gams-distrbution-version )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables for GAMS-TEMPLATE mode. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom gams-template-file "~/.gams-template" "*The name of a file used to store templates." :type 'file :group 'gams) (defcustom gams-save-template-change nil "*Nil means save the content of `gams-user-template-alist' into `gams-template-file' only when you quit Emacs. If non-nil, save `gams-user-template-alist' every time after you made any changes. If your Emacs often crashes, you may had better set it to non-nil." :type 'boolean :group 'gams) (defcustom gams-template-cont-color nil "*Non-nil means colorization of *Template Content* buffer. Non-nil makes the speed of template-mode very slow." :type 'boolean :group 'gams) (defcustom gams-template-mark "%c" "*The mark that indicates the point of cursor in a template." :type 'string :group 'gams) (defcustom gams-special-comment-symbol "com:" "*The symbol that indicates the special comment." :type 'string :group 'gams) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables for font-lock. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom gams-font-lock-level 2 "*The default level of colring in GAMS mode. 0 => no color. 1 => minimum. 2 => maximize." :group 'gams :type 'integer) (defcustom gams-lst-font-lock-level 2 "*The default level of coloring in GAMS-LST mdoe. 0 => no color. 1 => minimum. 2 => maximize." :group 'gams :type 'integer) (defcustom gams-ol-font-lock-level 2 "*The default level of coloring in GAMS-OUTLINE mode. 0 => no color. 1 => minimum. 2 => maximize." :group 'gams :type 'integer) (defcustom gams-lst-mode-hook nil "*GAMS-LST mode hooks." :type 'hook :group 'gams) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables for GAMS-LST mode. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar gams-lst-gms-extention "gms" "*GAMS program file extention.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables for automatic indent. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom gams-indent-on t "*If non-nil, automatic indent for gams mode is enabled. If nil, automatic indent doesn't work and tab key insert tab itself." :type 'boolean :group 'gams) (defcustom gams-indent-number 8 "*Indent number for general statemets." :type 'integer :group 'gams) (defcustom gams-indent-number-loop 8 "*Indent number in loop type environment. loop type statement means \"loop\", \"if\", \"while\", \"for\" etc." :type 'integer :group 'gams) (defcustom gams-indent-number-mpsge 8 "*Indent number in mpsge type environment. MPSGE type statement means \"$sector:\", \"$commodities:\", \"$prod:\" etc." :type 'integer :group 'gams) (defcustom gams-indent-number-equation 8 "*Indent number for equation definition." :type 'integer :group 'gams) (defcustom gams-indent-equation-on t "*Non-nil means indent equation blocks. If nil, already written equations are not affected by `gams-indent-line'." :type 'boolean :group 'gams) (defcustom gams-indent-more-indent nil "Non-nil means more indentation." :type 'boolean :group 'gams) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables for GAMS-OUTLINE mode. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom gams-ol-height 15 "*The default height of the OUTLINE buffer with one LST buffer. You can change the height of the OUTLINE buffer with `gams-ol-narrow-one-line' and `gams-ol-widen-one-line'." :type 'integer :group 'gams) (defcustom gams-ol-height-two 8 "*The default height of the OUTLINE buffer with two LST buffers. You can change the height of the OUTLINE buffer with `gams-ol-narrow-one-line' and `gams-ol-widen-one-line'." :type 'integer :group 'gams) (defcustom gams-ol-external-program nil "*The name of external program for creating GAMS-OUTLINE buffer. If you use external program for GAMS-OUTLINE mode, you need the proper value to this variable. As the external program, you can use the C program (gamsolc.exe) or the Perl script (gamsolperl.pl). The C program works faster than the Perl script, but the C program is offered only for MS windows (I cannot compile the program with gcc on Unix). The Perl script gamsolperl.pl works both on MS windows and Unix systems as long as Perl5 is installed in that system. If you are MS windows user, use gamsolc.exe and if you are Unix user, use gamsolperl.pl. If you use the C program (gamsolc.exe). and it is localted at the directory \"c:/home/gams\" (setq gams-ol-external-program \"c:/home/gams/gamsolc.exe\") If you use the Perl script gamsolperl.pl and it is located at the directory \"c:/home/gams\" (setq gams-ol-external-program \"c:/home/gams/gamsperl.pl\") Moreover, you need to set the proper value to `gams-perl-command' if you use gamsolperl.pl. This variable matters only if you use the command `gams-outline-external'. See the explanation of `gams-outline-external', too." :type 'file :group 'gams) (defcustom gams-perl-command nil "*The Perl command name. If you assign \"gamsolperlp.pl\" to `gams-ol-external-program', set the perl program to this variable, e.g. (setq gams-perl-command \"c:/Perl/bin/perl.exe\") If the directory of perl is included in PATH environmental variable, then just set the command name in stead of the full path: (setq gams-perl-command \"perl\") This variable matters only if you use the command `gams-outline-external'. See the explanation of `gams-outline-external', too." :type 'file :group 'gams) (defcustom gams-ol-view-item '(("SUM" . t) ("VAR" . t) ("EQU" . t) ("PAR" . t) ("SET" . t) ("VRI" . t) ("LOO" . t) ("OTH" . t) ("COM" . t)) "The default alist of viewable items. Each list consists of a pair of the item name and its flag (\"ITEM_NAME\" . flag) Non-nil of flag means the item is viewable by default. The order of items has the meaning in this alist. Items are listed in the SELECT-ITEM buffer according to this order. So, if you want to show MAR on the top, you must write MAR at the fisrt in this alist." :type '(repeat (cons :tag "option" (string :tag "item") (boolean :tag "flag"))) :group 'gams) (defcustom gams-ol-item-name-width 18 "The width of item name field in GAMS-OUTLINE." :type 'integer :group 'gams) (defvar gams-ol-use-mouse t "Non-nil means use mouse click in GAMS-OUTLINE.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Define customizable variables end here. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Other variables. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; (defvar gams-manuals-alist-base '(("User-Manual" . "GAMSUsersGuide.pdf") ("Solver-Manual (Table of Content)" . "gamssolvers.pdf") ("Tutorial" . "Tutorial.pdf") ("McCarl-User-Guide" . "mccarlgamsuserguide.pdf") ("BDMLP-Solver" . "bdmlp.pdf") ("CONOPT-Solver" . "conopt.pdf") ("CPLEX-Solver" . "cplex.pdf") ("DECIS-Solver" . "decis.pdf") ("DICOPT-Solver" . "dicopt.pdf") ("GAMSBAS-Solver" . "gamsbas.pdf") ("GAMSCHK-Solver" . "gamschk.pdf") ("MILES-Solver" . "miles.pdf") ("MINOS-Solver" . "minos.pdf") ("MPSGE-Solver" . "mpsge.pdf") ("MPSWRITE-Solver" . "mpswrite.pdf") ("OSL-Solver" . "osl.pdf") ("OSLSE-Solver" . "oslse.pdf") ("PATH-Solver" . "path.pdf") ("SBB-Solver" . "sbb.pdf") ("SNOPT-Solver" . "snopt.pdf") ("SOLVERINTRO-Solver" . "solverintro.pdf") ("XA-Solver" . "xa.pdf") ("XPRESS-Solver" . "xpress.pdf") ("XPRESSLICENSING-Solver" . "xpresslicensing.pdf") ("Ask-Tool" . "ask.pdf") ("GAMSIDE-Tool" . "gamside.pdf") ("GDX2ACESS-Tool" . "gdx2access.pdf") ("GDXUTILS-Tool" . "gdxutils.pdf") ("GDXVIEWER-Tool" . "gdxviewer.pdf") ("MDB2GMS-Tool" . "mdb2gms.pdf") ("SHELLEXECUTE-Tool" . "shellexecute.pdf") ("SQL2GMS-Tool" . "sql2gms.pdf") ("XLS2GMS-Tool" . "xls2gms.pdf") ("Windows-Install" . "win-install.pdf") ("Unix-Install" . "unix-install.pdf") ("PC-Install" . "pc-install.pdf") ) ) (defvar gams-statement-up '("SET" "SETS" "SCALAR" "SCALARS" "TABLE" "PARAMETER" "PARAMETERS" "EQUATION" "EQUATIONS" "VARIABLE" "VARIABLES" "POSITIVE VARIABLE" "POSITIVE VARIABLES" "NEGATIVE VARIABLE" "NEGATIVE VARIABLES" "INTEGER VARIABLE" "INTEGER VARIABLES" "BINARY VARIABLE" "BINARY VARIABLES" "ALIAS" "OPTION" "EXECUTE_UNLOAD" "SOLVE" "MODEL" "DISPLAY" "LOOP" "IF" "SUM" "PROD") "*The default list of GAMS statements. Used for candidate of statement inserting. Use upper case to register statements in this variable.") (defvar gams-dollar-control-up '("BATINCLUDE" "EXIT" "INCLUDE" "LIBINCLUDE" "OFFTEXT" "ONTEXT" "SETGLOBAL" "SYSINCLUDE" "TITLE") "The default list of GAMS dollar control options. Used for candidate of dollar control inserting. Use upper case to register dollar control options in this variable.") (defvar gams-statement-mpsge ; MPSGE '("MODEL:" "COMMODITIES:" "CONSUMERS:" "CONSUMER:" "SECTORS:" "SECTOR:" "PROD:" "DEMAND:" "REPORT:" "CONSTRAINT:" "AUXILIARY:") "The default list of MPSGE statements. Used for candidate of MPSGE dollar control inserting. Use upper case to register mpsge statements in this variable.") (defvar gams-run-key ?s "*Key to run GAMS in the process menu.") (defvar gams-kill-key ?k "*Key to kill GAMS process in the process menu.") (defvar gams-option-key ?o "*Key to select command option in the process menu.") (defvar gams-change-command-key ?c "*Key to select GAMS command in the process menu.") ;;;;; Key bindgings. (defcustom gams-olk-1 "?" "*Key for `gams-ol-help'." :type 'string :group 'gams-keys) (defcustom gams-olk-4 "t" "*Key for `gams-ol-select-item'." :type 'string :group 'gams-keys) (defcustom gams-olk-5 " " "*Key for `gams-ol-view-base'." :type 'string :group 'gams-keys) (defcustom gams-olk-6 "q" "*Key for `gams-ol-quit'." :type 'string :group 'gams-keys) (defcustom gams-olk-7 "m" "*Key for `gams-ol-mark'." :type 'string :group 'gams-keys) (defcustom gams-olk-8 "T" "*Key for `gams-ol-item'." :type 'string :group 'gams-keys) ;;; Key for GAMS-LST mode. (defcustom gams-lk-1 "i" "Key for `gams-lst-jump-to-input-file'." :type 'string :group 'gams-keys) (defcustom gams-lk-2 "u" "Key for `gams-lst-jump-to-error-file'." :type 'string :group 'gams-keys) (defcustom gams-lk-3 "y" "Key for `gams-lst-view-error'." :type 'string :group 'gams-keys) (defcustom gams-lk-4 "b" "Key for `gams-lst-jump-to-input-file-2'." :type 'string :group 'gams-keys) (defcustom gams-lk-5 "l" "Key for `gams-lst-jump-to-line'." :type 'string :group 'gams-keys) (defcustom gams-choose-font-lock-level-key "\C-c\C-f" "*The keybinding for `gams-choose-font-lock-level'." :type 'string :group 'gams-keys) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Non-customizable variables. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; It is not recommended to change the values of variables below. ;; They are basically intended to be used internally. ;; ;;; Buffer local variables for end-of-line and inline comments (setq-default gams-eolcom-symbol nil) (setq-default gams-inlinecom-symbol-start nil) (setq-default gams-inlinecom-symbol-end nil) (defvar gams-statement-file-already-read nil) (if (and (not gams-statement-file-already-read) (file-exists-p gams-statement-file)) (condition-case err (progn (load-file gams-statement-file) (setq gams-statement-file-already-read t)) (error (message "Error(s) in %s! Need to check; %s" gams-statement-file (error-message-string err)) (sleep-for 1)))) ;; Variables for representing (X)Emacs versions. (defvar gams-xemacs (string-match "XEmacs" emacs-version)) (defvar gams-emacs (if gams-xemacs nil t)) (defvar gams-win32 (memq system-type '(ms-dos windows-nt))) (defvar gams-dos (memq system-type '(ms-dos windows-nt OS/2))) (defvar gams-emacs-19 (and gams-emacs (= emacs-major-version 19))) (defvar gams-emacs-20 (and gams-emacs (= emacs-major-version 20))) (defvar gams-emacs-21 (and gams-emacs (= emacs-major-version 21))) (defvar gams-emacs-21.2 (and gams-emacs (string-match "21.2" emacs-version))) (defvar gams-emacs-21.3 (and gams-emacs (string-match "21.3" emacs-version))) (defvar gams-emacs-22 (and gams-emacs (= emacs-major-version 22))) (defvar gams-emacs-23 (and gams-emacs (= emacs-major-version 23))) (defvar gams-xemacs-21 (and gams-xemacs (= emacs-major-version 21))) ;;; If Emacs 20, define `gams-replace-regexp-in-string'. This code is ;;; `replace-regexp-in-string' from subr.el in the Emacs 21 distribution. (eval-when-compile (if (fboundp 'replace-regexp-in-string) (fset 'gams-replace-regexp-in-string 'replace-regexp-in-string) (defun gams-replace-regexp-in-string (regexp rep string &optional fixedcase literal subexp start) "Replace all matches for REGEXP with REP in STRING. This code is from subr.el in Emacs 21 distribution. Return a new string containing the replacements. Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the arguments with the same names of function `replace-match'. If START is non-nil, start replacements at that index in STRING. REP is either a string used as the NEWTEXT arg of `replace-match' or a function. If it is a function it is applied to each match to generate the replacement passed to `replace-match'; the match-data at this point are such that match 0 is the function's argument. To replace only the first match (if any), make REGEXP match up to \\' and replace a sub-expression, e.g. (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1) => \" bar foo\" " ;; To avoid excessive consing from multiple matches in long strings, ;; don't just call `replace-match' continually. Walk down the ;; string looking for matches of REGEXP and building up a (reversed) ;; list MATCHES. This comprises segments of STRING which weren't ;; matched interspersed with replacements for segments that were. ;; [For a `large' number of replacments it's more efficient to ;; operate in a temporary buffer; we can't tell from the function's ;; args whether to choose the buffer-based implementation, though it ;; might be reasonable to do so for long enough STRING.] (let ((l (length string)) (start (or start 0)) matches str mb me) (save-match-data (while (and (< start l) (string-match regexp string start)) (setq mb (match-beginning 0) me (match-end 0)) ;; If we matched the empty string, make sure we advance by one char (when (= me mb) (setq me (min l (1+ mb)))) ;; Generate a replacement for the matched substring. ;; Operate only on the substring to minimize string consing. ;; Set up match data for the substring for replacement; ;; presumably this is likely to be faster than munging the ;; match data directly in Lisp. (string-match regexp (setq str (substring string mb me))) (setq matches (cons (replace-match (if (stringp rep) rep (funcall rep (match-string 0 str))) fixedcase literal str subexp) (cons (substring string start mb) ; unmatched prefix matches))) (setq start me)) ;; Reconstruct a string from the pieces. (setq matches (cons (substring string start l) matches)) ; leftover (apply #'concat (nreverse matches))))))) ;; For `make-overlay'. (eval-and-compile (when gams-xemacs (require 'overlay))) ;; For `find-lisp-find-files'. (eval-and-compile (require 'find-lisp)) (defvar gams-lst-extention "lst" "GAMS LST file extention.") (defvar gams-fill-prefix nil "fill-prefix used for auto-fill-mode. The default value is nil.") (defvar gams-user-statement-list nil) (defvar gams-user-dollar-control-list nil) ;; (defvar gams-paragraph-start "[ \t]*$\\|^[\f\n]") (setq-default gams-paragraph-start "^\f\\|$\\|^[*]") (defvar gams*command-process-buffer "*GAMS") (defvar gams-statement-down (mapcar 'downcase gams-statement-up)) (defvar gams-dollar-control-down (mapcar 'downcase gams-dollar-control-up)) (defvar gams-statement-alist nil "?") (defvar gams-dollar-control-alist nil "?") (defvar gams-statement-regexp nil) ;;; From EPO. (defconst gams:frame-feature-p (and (fboundp 'make-frame) window-system)) ;;; From yatexprc.el. (defvar gams:shell-c (or (and (boundp 'shell-command-option) shell-command-option) (and (boundp 'shell-command-switch) shell-command-switch) (if (string-match "command.com\\|cmd.exe\\|start.exe" shell-file-name) "/c" "-c")) "Shell option for command execution.") ;; Set `gams*buffer-substring' to `buffer-substring-no-properties' if it ;; exits. Otherwise set to `buffer-substring'. (if (fboundp 'buffer-substring-no-properties) (fset 'gams*buffer-substring 'buffer-substring-no-properties) (fset 'gams*buffer-substring 'buffer-substring)) (cond ((fboundp 'screen-height) (fset 'gams*screen-height 'screen-height) (fset 'gams*screen-width 'screen-width)) ((fboundp 'frame-height) (fset 'gams*screen-height 'frame-height) (fset 'gams*screen-width 'frame-width)) (t (error "I don't know how to run GAMS on this Emacs..."))) ;;; (defvar gams-mode-syntax-table nil ;;; "Syntax table for gams-mode.") ;;; Autoload setting. ; For autoloading of GAMS mode. (setq auto-mode-alist (cons (cons (format "\\.\\(xyz\\|%s\\)$" (regexp-opt (append (mapcar 'downcase gams-file-extension) (mapcar 'upcase gams-file-extension)))) 'gams-mode) auto-mode-alist)) (autoload 'gams-mode "gams" "Enter GAMS mode" t) ; For GAMS-LST mode. (setq auto-mode-alist (cons (cons "\\.\\(LST\\|lst\\)$" 'gams-lst-mode) auto-mode-alist)) (autoload 'gams-lst-mode "gams" "Enter GAMS-LST mode" t) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Code for font-lock. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; Define faces. (defvar gams-mpsge-face 'gams-mpsge-face "Face for MPSGE statements.") (defvar gams-misc-face 'gams-misc-face "Face for misc.") (defvar gams-comment-face 'gams-comment-face "Face for comment.") (defvar gams-dollar-face 'gams-dollar-face "Face for dollar control options.") (defvar gams-statement-face 'gams-statement-face "Face for GAMS statments.") (defvar gams-lst-par-face 'gams-lst-par-face "Face for PARAMETER in GAMS-LST mode.") (defvar gams-lst-set-face 'gams-lst-set-face "Face for PARAMETER in GAMS-LST mode.") (defvar gams-lst-var-face 'gams-lst-var-face "Face for VAR in GAMS-LST mode.") (defvar gams-lst-equ-face 'gams-lst-equ-face "Face for EQU in GAMS-LST mode.") (defvar gams-lst-vri-face 'gams-lst-vri-face "Face for VARIABEL in GAMS-LST mode.") (defvar gams-lst-oth-face 'gams-lst-oth-face "Face for OTH entry in GAMS-OUTLINE mode.") (defvar gams-lst-warning-face 'gams-lst-warning-face "Face for warning in GAMS-LST mode.") (defvar gams-lst-program-face 'gams-lst-program-face "Face for program listing in GAMS-LST mode.") (defvar gams-ol-loo-face 'gams-ol-loo-face "Face for program listing in GAMS-LST mode.") (defvar gams-string-face 'gams-string-face "Face for string.") (defvar gams-operator-face 'gams-operator-face "Face for operator.") (defvar gams-slash-face 'gams-slash-face "Face for set and parameter elements lying between slashes.") (defvar gams-explanation-face 'gams-explanation-face "Face for explanatory texts in GAMS mode.") (defvar gams-oth-cont-face 'gams-oth-cont-face "Face for the content of OTH item in GAMS-OUTLINE mode.") (defvar gams-title-face 'gams-title-face "Face for $title in GAMS mode.") (defvar gams-highline-face 'gams-highline-face "*Symbol face used to highlight the current line.") (defvar gams-highline-sub-face 'gams-highline-sub-face "*Symbol face used to highlight the current line.") (defvar gams-sil-mpsge-face 'gams-sil-mpsge-face) (defvar gams-sil-dollar-face 'gams-sil-dollar-face) (defvar gams-func-face 'gams-func-face) (defvar gams-def-face 'gams-def-face) ;; This regular expression (defun gams-regexp-opt (strings &optional paren) (if gams-xemacs (regexp-opt strings paren) ; (regexp-opt strings paren t) ;; For old XEmacs. (regexp-opt strings paren))) ;; (gams-regexp-opt ;; (list ;; "comment" "eolcom" "gdxin" "gdxout" "inlinecom" "maxcol" "mincol" "offeolcom" ;; "offinline" "offmargin" "offnestcom" "offtext" "onelcom" "oninline" ;; "onmargin" "onnestcom" "ontext" "dollar" "offdigit" "offempty" ;; "offend" "offeps" "offglobal" "offwarning" "ondigit" "onempty" "onend" ;; "oneps" "onglobal" "onwarning" "use205" "use225" "use999" "double" ;; "eject" "hidden" "lines" "load" "offdollar" "offinclude" "offlisting" ;; "offupper" "ondollar" "oninclude" "onlisting" "onupper" "single" ;; "stars" "stitle" "title" "offsymlist" "offsymxref" "offuellist" ;; "offuelxref" "onsymlist" "onsymxref" "onuellist" "onuelxref" "abort" ;; "batinclude" "call" "clear" "echo" "error" "exit" "goto" "if" "if exist" ;; "include" "kill" "label" "libinclude" "onglobal" "onmulti" "offglobal" ;; "offmulti" "phantom" "set" "setglobal" "setlocal" "shift" "sysinclude") t) (setq gams-dollar-regexp "\\(abort\\|batinclude\\|c\\(?:all\\|lear\\|omment\\)\\|do\\(?:llar\\|uble\\)\\|e\\(?:cho\\|ject\\|olcom\\|rror\\|xit\\)\\|g\\(?:dx\\(?:in\\|out\\)\\|oto\\)\\|hidden\\|i\\(?:f\\(?: exist\\)?\\|n\\(?:clude\\|linecom\\)\\)\\|kill\\|l\\(?:abel\\|i\\(?:binclude\\|nes\\)\\|o\\(?:ad\\|g\\)\\)\\|m\\(?:\\(?:ax\\|in\\)col\\)\\|o\\(?:ff\\(?:d\\(?:igit\\|ollar\\)\\|e\\(?:mpty\\|nd\\|olcom\\|ps\\)\\|global\\(?:\\)?\\|in\\(?:\\(?:clud\\|lin\\)e\\)\\|listing\\|m\\(?:argin\\|ulti\\)\\|nestcom\\|sym\\(?:list\\|xref\\)\\|text\\|u\\(?:el\\(?:list\\|xref\\)\\|pper\\)\\|warning\\)\\|n\\(?:d\\(?:igit\\|ollar\\)\\|e\\(?:lcom\\|mpty\\|nd\\|ps\\)\\|global\\(?:\\)?\\|in\\(?:\\(?:clud\\|lin\\)e\\)\\|listing\\|m\\(?:argin\\|ulti\\)\\|nestcom\\|sym\\(?:list\\|xref\\)\\|text\\|u\\(?:el\\(?:list\\|xref\\)\\|pper\\)\\|warning\\)\\)\\|phantom\\|s\\(?:et\\(?:\\(?:glob\\|loc\\)al\\)?\\|hift\\|ingle\\|t\\(?:ars\\|itle\\)\\|ysinclude\\)\\|title\\|use\\(?:2\\(?:[02]5\\)\\|999\\)\\)" ) (defvar gams-mpsge-regexp (gams-regexp-opt gams-statement-mpsge t) "Regular expression for mpsge dollar control") (defvar gams-statement-regexp-base-sub (gams-regexp-opt (list "abort" "acronym" "acronyms" "alias" "assign" "binary" "diag" "display" "equation" "equations" "execute_unload" "integer" "loop" "model" "models" "negative" "option" "options" "parameter" "parameters" "positive" "sameas" "scalar" "scalars" "set" "sets" "sos1" "sos2" "system" "table" "variable" "variables" "xor" "repeat" "until" "while" "if" "then" "else" "elseif" "semicont" "semiint" "file" "files" "put" "putpage" "puttl" "free" "solve" "for" "errorf" "floor" "mapval" "mod" "putclose" ) t) "Regular expression for reserved words.") (defvar gams-statement-list-base (list "abort" "acronym" "acronyms" "alias" "all" "and" "assign" "binary" "card" "diag" "display" "eps" "eq" "equation" "equations" "execute_unload" "ge" "gt" "inf" "integer" "le" "loop" "lt" "maximising" "maximizing" "minimising" "minimizing" "model" "models" "na" "ne" "negative" "not" "option" "options" "or" "ord" "parameter" "parameters" "positive" "prod" "sameas" "scalar" "scalars" "set" "sets" "smax" "smin" "sos1" "sos2" "sum" "system" "table" "using" "variable" "variables" "xor" "yes" "repeat" "until" "while" "if" "then" "else" "elseif" "semicont" "semiint" "file" "files" "put" "putpage" "puttl" "free" "no" "solve" "for" "abort" "abs" "arctan" "ceil" "cos" "errorf" "exp" "floor" "log" "log10" "mapval" "max" "min" "mod" "normal" "power" "round" "sign" "sin" "sqr" "sqrt" "trunc" "uniform" "putclose")) (defvar gams-statement-regexp-base (gams-regexp-opt gams-statement-list-base t) "Regular expression for statements It is used for font-lock.") (defvar gams-statement-regexp-1 (concat "^[ \t]*" gams-statement-regexp-base "[^-a-zA-Z0-9_:*]+") "Regular expression for GAMS statements It is used for font-lock of level 1.") (defvar gams-statement-regexp-2 (concat "\\(^\\|[\n]\\|[^-$a-zA-Z0-9_]+\\)" gams-statement-regexp-base "[^-a-zA-Z0-9_:*]+") "Regular expression for GAMS statements It is used for font-lock of level 2.") ;;; GAMS mode. (defface gams-comment-face '((((class color) (background light)) (:bold nil :foreground "#009000")) (((class color) (background dark)) (:bold nil :italic nil :foreground "green"))) "Face for commented out texts." :group 'gams-faces) (defface gams-mpsge-face '((((class color) (background light)) (:bold nil :foreground "#2080e0")) (((class color) (background dark)) (:bold nil :foreground "hot pink"))) "Face for MPSGE statements." :group 'gams-faces) (defface gams-statement-face '((((class color) (background light)) (:bold nil :foreground "#0000e0")) (((class color) (background dark)) (:bold nil :foreground "cyan"))) "Face for GAMS statements." :group 'gams-faces) (defface gams-dollar-face '((((class color) (background light)) (:bold nil :foreground "#e0e000")) (((class color) (background dark)) (:bold nil :foreground "yellow"))) "Face for dollar control options." :group 'gams-faces) (defface gams-string-face '((((class color) (background light)) (:bold nil :foreground "#a000a0")) (((class color) (background dark)) (:bold nil :italic nil :foreground "orange"))) "Face for quoted string in GAMS mode." :group 'gams-faces) (defface gams-operator-face '((((class color) (background light)) (:bold nil :foreground "#e00000")) (((class color) (background dark)) (:bold nil :foreground "#ccaaff"))) "Face for operators in GAMS mode." :group 'gams-faces) (defface gams-slash-face '((((class color) (background light)) (:bold nil :foreground "#f00090")) (((class color) (background dark)) (:bold nil :italic nil :foreground "light pink"))) "Face for set and parameter elements lying between slashes." :group 'gams-faces) (defface gams-explanation-face '((((class color) (background light)) (:bold nil :foreground "#c09000")) (((class color) (background dark)) (:bold nil :italic nil :foreground "khaki"))) "Face for explanatory texts in GAMS mode." :group 'gams-faces) (defface gams-oth-cont-face '((((class color) (background light)) (:bold nil :foreground "gray50")) (((class color) (background dark)) (:bold nil :foreground "khaki"))) "Face for the content of OTH item in GAMS-OUTLINE mode." :group 'gams-faces) (defface gams-title-face '((((class color) (background light)) (:bold nil :underline t :foreground "#0000a0" :background "#ffffd0")) (((class color) (background dark)) (:bold nil :underline t :italic nil :foreground "#ffd0ff" :background "#000050"))) "Face for the content of OTH item in GAMS-OUTLINE mode." :group 'gams-faces) (defface gams-highline-face '((((class color) (background light)) (:bold nil :foreground "#f0f0f0" :background "#009000")) (((class color) (background dark)) (:bold t :italic nil :underline t :foreground "yellow"))) "Face for highline." :group 'gams-faces) ;;; GAMS-LST mode. (defface gams-lst-par-face '((((class color) (background light)) (:bold t :foreground "DodgerBlue")) (((class color) (background dark)) (:bold t :foreground "yellow"))) "Faces for PARAMETER entry in GAMS-LST mode." :group 'gams-faces) (defface gams-lst-set-face '((((class color) (background light)) (:bold t :foreground "light blue")) (((class color) (background dark)) (:bold t :foreground "sandy brown"))) "Face for SET entry in GAMS-LST mode." :group 'gams-faces) (defface gams-lst-var-face '((((class color) (background light)) (:bold t :foreground "hot pink")) (((class color) (background dark)) (:bold t :foreground "cyan"))) "Face for VAR endtry in GAMS-LST mode." :group 'gams-faces) (defface gams-lst-equ-face '((((class color) (background light)) (:bold t :foreground "lawn green")) (((class color) (background dark)) (:bold t :foreground "pink"))) "Face for EQU entry in GAMS-LST mode." :group 'gams-faces) (defface gams-lst-vri-face '((((class color) (background light)) (:bold t :foreground "purple")) (((class color) (background dark)) (:bold t :foreground "pale green"))) "Face for VARIABLE entry in GAMS-LST mode." :group 'gams-faces) (defface gams-lst-oth-face '((((class color) (background light)) (:bold t :foreground "gray60")) (((class color) (background dark)) (:bold t :italic nil :foreground "bisque"))) "Face for ?" :group 'gams-faces) (defface gams-lst-warning-face '((((class color) (background light)) (:bold t :foreground "red")) (((class color) (background dark)) (:bold t :foreground "red"))) "Face for warnings in GAMS-LST mode." :group 'gams-faces) (defface gams-lst-program-face '((((class color) (background light)) (:foreground "goldenrod")) (((class color) (background dark)) (:foreground "khaki"))) "Face for copied program listing in GAMS-LST mode." :group 'gams-faces) (defface gams-ol-loo-face '((((class color) (background light)) (:bold t :foreground "maroon")) (((class color) (background dark)) (:bold t :foreground "#7777ff"))) "Face for LOO entry in GAMS-OUTLINE mode." :group 'gams-faces) (defface gams-highline-sub-face '((((class color) (background light)) (:foreground "#f0f0f0" :background "purple")) (((class color) (background dark)) (:bold t :italic nil :underline t :foreground "pink"))) "Face for highline." :group 'gams-faces) (defface gams-sil-mpsge-face '((((class color) (background light)) (:bold nil :foreground "#2080e0")) (((class color) (background dark)) (:bold nil :italic nil :foreground "hot pink"))) "Face for MPSGE statements." :group 'gams-faces) (defface gams-sil-dollar-face '((((class color) (background light)) (:bold nil :foreground "#2080e0")) (((class color) (background dark)) (:bold nil :italic nil :foreground "#ffa0ff"))) "Face for dollar control in SIL mode." :group 'gams-faces) (defface gams-func-face '((((class color) (background light)) (:bold nil :foreground "pink")) (((class color) (background dark)) (:bold nil :italic nil :foreground "#ff30ff"))) "Face for ==." :group 'gams-faces) (defface gams-def-face '((((class color) (background light)) (:bold nil :foreground "blue" :bold t)) (((class color) (background dark)) (:bold t :italic nil :foreground "white"))) "Face for equation definition part in GAMS-??." :group 'gams-faces) (defvar gams-font-lock-keywords nil) (defvar gams-lst-font-lock-keywords nil) (defvar gams-ol-font-lock-keywords nil) (defvar gams-regexp-declaration-2 "\\(parameter\\|set\\|scalar\\|table\\|\\(free\\|positive\\|negative\\|binary\\|integer\\)*[ ]*variable\\|equation\\|model\\|file\\)[s]?") ;; gams-lst (defsubst gams-store-point-sol-sum (limit) "Store points for font-lock for SOLVE SUMMARY in OUTLINE mode." (let (beg end) (when (re-search-forward "SUM[ \t]+\\(SOLVE SUMMARY[ \t]+SOLVER[ \t]+STATUS[ \t]+=\\( [^1]\\| 1, MODEL STATUS = [^128]\\)\\)" limit t) (setq beg (match-beginning 1)) (setq end (line-end-position)) (store-match-data (list beg end)) t))) (defsubst gams-store-point-rep-sum (limit) "Store points for font-lock for REPORT SUMMARY in OUTLINE mode." (let (beg end) (when (re-search-forward "SUM[ \t]+\\(REPORT SUMMARY[ \t]+[[]\\([^0]\\|0, [^0]\\|0, 0, [^0]\\|0, 0, 0, [^0]\\|0, 0, 0, 0, [^0]\\)\\)" limit t) (setq beg (match-beginning 1)) (setq end (line-end-position)) (store-match-data (list beg end)) t))) ;;;;; Functions for storing points for font-lock. (defsubst gams-font-lock-commented-outp (&optional back) "Return t is comment character is found between bol and point." (save-excursion (let ((limit (point))) (save-match-data ;; Handle outlined code (if back (goto-char back) (re-search-backward "^\\|\C-m" (point-min) t)) (if (re-search-forward (concat "^[" gams-comment-prefix "]") limit t) t nil))))) (defun gams-font-lock-match-regexp (keywords limit beg end) "Search for regexp command KEYWORDS before LIMIT. Returns nil if none of KEYWORDS is found." (let (bb ee flag) (catch 'found (while t (if (not (re-search-forward keywords limit t)) (progn (setq flag nil) (throw 'found t)) (goto-char (setq bb (match-beginning 0))) (setq ee (match-end 0)) (cond ((or (gams-font-lock-commented-outp (match-beginning 0)) (gams-in-on-off-text-p)) ;; Return a nul match such that we skip over this pattern. ;; (Would be better to skip over internally to this function) (store-match-data (list nil nil)) (goto-char ee)) (t (let ((bb (match-beginning beg)) (ee (match-end end))) (store-match-data (list bb ee)) (goto-char ee) (setq flag t) (throw 'found t))))))) flag)) (defun gams-store-point-statement-1 (limit) "Store points for font-lock for GAMS statements. Level 1." (gams-font-lock-match-regexp gams-statement-regexp-1 limit 1 1)) (defun gams-store-point-statement-2 (limit) "Store points for font-lock for GAMS statements. Level 2." (gams-font-lock-match-regexp gams-statement-regexp-2 limit 2 2)) (defun gams-store-point-dollar (limit) "Store points for font-lock for dollar control options." (gams-font-lock-match-regexp (concat "\\(^\\|[^a-zA-Z0-9]+\\)\\([$]\\)[ \t]*" gams-dollar-regexp "[^a-zA-Z0-9$*]") limit 2 3)) (defun gams-store-point-single-quote (limit) "Store points for font-lock for texts in single quotations." (when gams-comment-prefix (gams-font-lock-match-regexp "[ \t(,]?\\(\'[^\n\']+\'\\)[), ;:\t\n]" limit 1 1))) (defun gams-store-point-double-quote (limit) "Store points for font-lock for texts in double quotations." (when gams-comment-prefix (gams-font-lock-match-regexp "[ \t(,]?\\(\"[^\n\"]+\"\\)[), ;:\t\n]" limit 1 1))) (defun gams-store-point-special-comment (limit) "Store points for font-lock for comment." (let ((key (concat "\\(----[ ]+[0-9]+[ ]+" (gams-regexp-opt (list gams-special-comment-symbol)) "[^\n]*\\)"))) (when (re-search-forward key limit t) (let ((beg (match-beginning 1)) (end (match-end 1))) (store-match-data (list beg end)) t)))) (defvar gams-font-lock-keywords-1 ;; (setq gams-font-lock-keywords-1 '( ;; Conditional dollar. ("[$]" (0 gams-dollar-face)) ;; Operator ("=\\(e\\|g\\|l\\|n\\)=" (0 gams-operator-face)) ;; Commented out text by ! in MPSGE code (gams-store-point-mpsge-comment (0 gams-comment-face t t)) ;; Standard GAMS statements. (gams-store-point-statement-1 (0 gams-statement-face nil t)) ;; Dollar control options. (gams-store-point-dollar (0 gams-dollar-face append t t)) ;; Explanatory texts. (gams-store-point-explanation (0 gams-explanation-face t t)) ;; Text in single quoatations. (gams-store-point-single-quote (0 gams-string-face t t)) ;; Text in double quoatations. (gams-store-point-double-quote (0 gams-string-face t t)) ;; End-of-line comment. (gams-store-point-eolcom (0 gams-comment-face t t)) ;; Inline comment. (gams-store-point-inlinecom (0 gams-comment-face t t)) ;; semicolon (";" (0 gams-lst-warning-face)) ;; Commented out texts by $hidden (gams-store-point-hidden-comment (0 gams-comment-face t t)) ;; Commented out texts by * (gams-store-point-comment (0 gams-comment-face t t)) ;; MPSGE dollar control options. ("\\$\\(AUXILIARY\\|CO\\(MMODITIES\\|NS\\(TRAINT\\|UMERS?\\)\\)\\|DEMAND\\|E\\(CHOP\\|ULCHK\\)\\|FUNLOG\\|MODEL\\|P\\(EPS\\|ROD\\)\\|REPORT\\|SECTORS?\\|WALCHK\\):" (0 gams-mpsge-face t t)) ;; the ontext - offtext pair. (gams-store-point-ontext (0 gams-comment-face t t)) ) "Font lock keyboards for GAMS mode. Level 1.") ;; ) (defvar gams-font-lock-keywords-2 ;;(setq gams-font-lock-keywords-2 '( ;; Operator ("=\\(e\\|g\\|l\\|n\\)=" (0 gams-operator-face)) ;; Semicolon (";" (0 gams-lst-warning-face)) ;; Conditional dollar. ("[$]" (0 gams-dollar-face)) ;; Standard GAMS statements. (gams-store-point-statement-2 (0 gams-statement-face nil t)) ;; Conditional dollar. ("[$]" (0 gams-dollar-face t t)) ;; Explanatory texts. (gams-store-point-explanation (0 gams-explanation-face t t)) ;; texts in slash pair. (gams-store-point-slash (0 gams-slash-face t t)) ;; Dollar control options. (gams-store-point-dollar (0 gams-dollar-face t t)) ;; Commented out text by ! in MPSGE code (gams-store-point-mpsge-comment (0 gams-comment-face t t)) ;; Text in double quoatations. (gams-store-point-double-quote (0 gams-string-face t t)) ;; Text in single quoatations. (gams-store-point-single-quote (0 gams-string-face t t)) ;; Inline comment. (gams-store-point-inlinecom (0 gams-comment-face t t)) ;; End-of-line comment. (gams-store-point-eolcom (0 gams-comment-face t t)) ;; title and stitle. ("^[$][s]?title[^\n]*$" (0 gams-title-face t t)) ;; Commented out texts by $hidden (gams-store-point-hidden-comment (0 gams-comment-face t t)) ;; Commented out texts by * (gams-store-point-comment (0 gams-comment-face t t)) ;; MPSGE dollar control options. ("^\\$\\(AUXILIARY\\|CO\\(MMODITIES\\|NS\\(TRAINT\\|UMERS?\\)\\)\\|DATECH\\|DEMAND\\|E\\(CHOP\\|ULCHK\\)\\|FUNLOG\\|MODEL\\|P\\(EPS\\|ROD\\)\\|REPORT\\|SECTORS?\\|WALCHK\\):" (0 gams-mpsge-face t t)) ;; the ontext - offtext pair. (gams-store-point-ontext (0 gams-comment-face t t)) ) "Font-Lock keyboards.") ;; ) (defvar gams-lst-font-lock-keywords-1 '(("^\\*\\*\\*\\*[^\n]+" (0 gams-lst-warning-face)) ("^\\(----\\)?[ \t]+[0-9]*[ ]PARAMETER[ ]+" (0 gams-lst-par-face)) ("^----[ ]+[0-9]+[ ]SET[ ]+" (0 gams-lst-set-face)) ("^\\(----\\)?[ \t]+[0-9]*[ ]VARIABLE[ ]+" (0 gams-lst-vri-face)) ) "Regular expression for font-lock in GAMS-LST mode. Level 1.") (defvar gams-lst-font-lock-keywords-2 (append gams-lst-font-lock-keywords-1 '(("\\(----[ ]+VAR[ ]+[^ ]+\\)[ ]*[^\n]+" (1 gams-lst-var-face)) ("\\(----[ ]+EQU[ ]+[^ ]+\\)[ ]*[^\n]+" (1 gams-lst-equ-face)) (gams-store-point-special-comment (0 gams-comment-face)) )) "Regular expression for font-lock in GAMS-LST mode. Level 2.") (defvar gams-ol-font-lock-keywords-1 '((gams-store-point-rep-sum (0 gams-lst-warning-face)) (gams-store-point-sol-sum (0 gams-lst-warning-face)) ("^\\([[]\\).*" (0 gams-comment-face)) ("^[ ]+\\(OTH\\)[ \t]+\\(.*\\)" (1 gams-lst-oth-face) (2 gams-oth-cont-face)) ("^[ ]+\\(SUM\\)" (1 gams-lst-warning-face))) "Regular expression for font-lock in GAMS-OUTLINE mode. Level 1.") (defvar gams-ol-font-lock-keywords-2 (append gams-ol-font-lock-keywords-1 '(("^[ ]+\\(PAR\\)[ \t]+" (1 gams-lst-par-face)) ("^[ ]+\\(SET\\)[ \t]+" (1 gams-lst-set-face)) ("^[ ]+\\(VAR\\)[ \t]+" (1 gams-lst-var-face)) ("^[ ]+\\(VRI\\)[ \t]+" (1 gams-lst-vri-face)) ("^[ ]+\\(EQU\\)[ \t]+" (1 gams-lst-equ-face)) ("^[ ]+\\(LOO\\)[ \t]+" (1 gams-ol-loo-face)) ("^\\*[ ]?\\(.*\\)" (0 gams-mpsge-face)))) "Regular expression for font-lock in GAMS-OUTLINE mode. Level 2.") (defun gams-store-point-comment (limit) "Store points for font-lock for comment." (when (re-search-forward (concat "^\\([" gams-comment-prefix "].*\\)$") limit t) (let ((beg (match-beginning 1)) (end (match-end 1))) (store-match-data (list beg end)) t))) (defun gams-store-point-hidden-comment (limit) "Store points for font-lock for comment." (when (re-search-forward "^\\($hidden.*\\)$" limit t) (let ((beg (match-beginning 1)) (end (match-end 1))) (store-match-data (list beg end)) t))) (defun gams-store-point-ontext (limit) "Store points for font-lock for ontext-offtext." (let (beg end flag) (catch 'found (while t (if (and (<= (point) limit) (re-search-forward "^$ontext" limit t)) (progn (setq beg (match-beginning 0)) (when (re-search-forward "^$offtext" limit t) (beginning-of-line) (if (gams-in-on-off-text-p) (progn (forward-line 1) (store-match-data (list beg (point))) (setq flag t) (throw 'found t)) (forward-line 1)))) (when (gams-in-on-off-text-p) (beginning-of-line) (setq beg (point)) (forward-line 1) (store-match-data (list beg (point))) (setq flag t)) (throw 'found t)))) flag)) (defun gams-check-decl-eol () "If there is nothing after the current point, return t. Otherwise nil." (let ((cur-po (point)) (end (line-end-position)) flag) (if (re-search-forward "[^ \t\n]" end t) (progn (goto-char cur-po) (if (looking-at (concat "[ \t]*\\([;]" (if gams-inlinecom-symbol-start (concat "\\|[" gams-inlinecom-symbol-start "]")) (if gams-eolcom-symbol (concat "\\|[" gams-eolcom-symbol "]")) "\\)")) ;; end of line. (setq flag t) ;; Identifier exits. (setq flag nil))) (setq flag t)) flag)) (defun gams-store-explanation () "Store the points of explanatory text if it exits." (let ((cur-po (point)) (end (line-end-position)) po-temp cont flag) (if (re-search-forward "[^ \t\n]" end t) ;; if something exists. (progn (goto-char cur-po) (catch 'found (while t (if (re-search-forward (concat "[ \t]*\\([;]\\|[/]" (if gams-inlinecom-symbol-start (concat "\\|[" gams-inlinecom-symbol-start "]")) (if gams-eolcom-symbol (concat "\\|[" gams-eolcom-symbol "]")) "\\)") end t) (progn (setq po-temp (match-beginning 0)) (when (and (not (gams-in-quote-p)) (not (gams-in-comment-p))) ;; if eol symbol exits (setq end po-temp) (throw 'found t)) ;; if eol symbol does not exit. (setq end end)) (throw 'found t)))) (setq cont (gams*buffer-substring cur-po end)) (if (string-match "[^ \t]" cont) (setq flag (list cur-po end)) (setq flag (list nil end)))) (setq flag (list nil end))) flag)) (defun gams-store-point-slash (limit) "Store points for font-lock for texts in slash pair." (let (cur-po beg end flag beg-decl po-a) (catch 'found (while t (setq cur-po (point)) ;; For XEmacs (when (and gams-xemacs (not (equal 0 (current-column)))) ; koko dame. (forward-line 1)) (if (and (<= cur-po limit) (re-search-forward "/" limit t)) ;; If / is found. (if (and (not (gams-in-on-off-text-p)) (not (gams-check-line-type nil t)) (setq beg-decl (gams-in-declaration-p)) (not (gams-in-quote-p)) (not (gams-in-comment-p))) ;; If / is valid. (progn (setq beg (1- (point))) (if (gams-slash-end-p beg-decl) ;; Outside slash pair. (progn (goto-char cur-po) (setq beg (line-beginning-position)) (setq end (line-end-position)) (when (gams-slash-in-line-p) (search-forward "/" limit t) (setq end (point))) (if (looking-at "^\n") (store-match-data (list beg (+ 1 end))) (store-match-data (list beg end))) (forward-line 1) (setq flag t) (throw 'found t)) ;; Inside slash pair. (cond ((not (save-excursion (re-search-forward "/" limit t))) ;; If the next slash is not found, (if (> beg-decl cur-po) ;; Abort. (throw 'found t) (goto-char cur-po) (setq beg (line-beginning-position) end (line-end-position)) (beginning-of-line) (cond ((gams-slash-in-line-p) ;; The current line includes one slash. (if (gams-slash-end-p beg-decl) ;; If beginning-of-line is not in slash pair (if (progn (end-of-line) (gams-slash-end-p beg-decl)) ;; If end-of-line is not in slash pair. (throw 'found t) ;; If end-of-line is in slash pair. (search-backward "/" beg t) (store-match-data (list (point) end)) (forward-line 1) (setq flag t) (throw 'found t)) ;; If beginning-of-line is in slash pair. (search-forward "/" nil t) (store-match-data (list beg (point))) (forward-line 1) (setq flag t) (throw 'found t))) (t ;; The current line doesn't include a slash. (if (gams-slash-end-p beg-decl) ;; If the current point is outside slash pair. (throw 'found t) ;; If the current point is inside slash pair. (store-match-data (list beg end)) (forward-line 1) (setq flag t) (throw 'found t)) )))) (t ;; Otherwise. (catch 'foo (while t (if (not (re-search-forward "/" nil t)) (progn (setq end limit) (throw 'foo t)) (when (and (setq end (match-end 0)) (not (gams-in-quote-p)) (not (gams-in-comment-p)) (not (gams-check-line-type nil t))) (throw 'foo t))))) (store-match-data (list beg end)) (setq flag t) (forward-line 1) (throw 'found t))))) ;; If conditions are not satisfied, search the next slash. ;; i.e. do nothing here. nil) ;; If slash is not found. (let ((po-match (gams-in-declaration-p))) (if (not po-match) ;; Outside declaration environement. (throw 'found t) ;; Inside declaration environement. (if (gams-slash-end-p po-match) ;; Outside slash pair. (throw 'found t) ;; Inside slash pair. (if (looking-at "^\n") (store-match-data (list (line-beginning-position) (+ 1 (line-end-position)))) (store-match-data (list (line-beginning-position) (line-end-position)))) (forward-line 1) (setq flag t) (throw 'found t) )))))) flag)) (defun gams-jump-next-slash (begin) "Return the point of the next slash if the current point is in a slash pair. If the current point is not in a slash pair, do nothing. BEGIN is the begin point of declaration." (let ((count 0) (cur-po (point)) po) (save-excursion (goto-char begin) (while (re-search-forward "/" cur-po t) (when (and (not (gams-in-comment-p)) (not (gams-in-quote-p))) (setq count (+ 1 count)))) (when (and (> count 0) (oddp count)) (while (not (and (re-search-forward "/" nil t) (not (gams-in-comment-p)) (not (gams-in-quote-p)))) t) (setq po (point)))) po)) (defun gams-store-point-explanation (limit) "Store points for font-lock for explanatory text." (let ((cur-po (point)) decl-end flag cont beg end ontext po-a po-b) (catch 'found (while t ;; In an ontext-offtext pair? (setq ontext (gams-in-on-off-text-p)) (cond ;; If not in an ontext-offtext pair and if in declaration. ((and (not ontext) (setq po-b (gams-in-declaration-p))) (if (not (< (point) limit)) ;; If the current point exceeds limit. (throw 'found t) ;; If the current point does not exceed limit. (setq decl-end (gams-sid-return-block-end (point))) (if (not (< (point) decl-end)) ;; if current point reaches the end of the declaration ;; block, go out of it. (forward-char 1) ;; if the current point is inside the declaration block. (setq cont (gams-store-point-explanation-get-explanation po-b cur-po decl-end limit)) (when cont (store-match-data cont)) ;; Even if cont is nil, set t to flag in order to continue the ;; coloring for the subsequence part. (setq flag t) (throw 'found t)))) ;; Point exceeds limit. ((>= (point) limit) (throw 'found t) (setq flag nil)) ;; If not in declaration block, search declaration block. ((and (if (re-search-forward (concat "^[ \t]*" gams-regexp-declaration-2 "[ \t\n]+") limit t) (setq po-a (match-beginning 1)) (throw 'found t)) (not (setq ontext (gams-in-on-off-text-p)))) ;; if declaration block is found. (progn (setq decl-end (gams-sid-return-block-end (point))) (setq cont (gams-store-point-explanation-get-explanation po-a cur-po limit decl-end)) ;; Even if cont is nil, set t to flag in order to continue the ;; coloring for the subsequence part. (when cont (store-match-data cont) (setq flag t) (throw 'found t)))) ;; In the ontext-offtext pair. (ontext (if (re-search-forward "^$offtext" limit t) nil (throw 'found t) (setq flag nil))) ;; Other cases. (t (throw 'found t) (setq flag nil))))) ;; If item is found, flag is t. flag)) (defun gams-store-point-explanation-get-explanation (begin current limit end) "BEGIN is the beginning point of the declaration block. CURRENT is the current point. END is the point of the declaration block." (let ((lim (min limit end)) (eol-sym (concat "[" gams-eolcom-symbol "]")) (inl-sym (concat "[" gams-inlinecom-symbol-start "]")) ex-list ex-beg ex-end iden-flag) (catch 'found (while t ;; Skip irrelevant lines. (while (gams-check-line-type) (forward-line 1) (when (eobp) (throw 'found t))) (if (>= (point) lim) ;; if current point exceeds limit, do nothing. (throw 'found t) (cond ;; If reaced to the end of the buffer. ((eobp) (throw 'found t)) ;; If the next char is space or tab. ((looking-at "[ \t]") (skip-chars-forward "[ \t]")) ;; If the next char is end-of-line comment. ((looking-at eol-sym) (forward-line 1)) ;; If the next char is inline comment. ((looking-at inl-sym) (gams-sid-goto-inline-comment-end)) ;; If the next char is \n. ((looking-at "\n") (when iden-flag (setq iden-flag nil)) (forward-char 1)) ;; If the next char is /. ((looking-at "/") (goto-char (or (gams-sid-next-slash) (line-end-position)))) ;; If the next char is ' or ". ((or (looking-at "'\\|\"")) (if (not iden-flag) (forward-char 1) (setq ex-beg (match-beginning 0) ex-end (gams-sil-get-alist-exp t)) (goto-char ex-end) (when (<= current ex-beg) (setq ex-list (list ex-beg ex-end)) (throw 'found t)))) ;; If the next char is ",". ((looking-at ",") (when iden-flag (setq iden-flag nil)) (forward-char 1)) ;; If the next char is ;. ((looking-at ";") (forward-char 1) (throw 'found t)) ;; If the next char is (. ((looking-at "(") (if (re-search-forward ")" (line-end-position) t) (point) (end-of-line) ;; Which one is better? (throw 'found t)) ) ;; Otherwise (i.e. identifier or explanatory text are found). (t (if iden-flag ;; If an identifier is already found, the next string is ;; explanatory text. (progn (setq ex-beg (point)) (setq ex-end (gams-sil-get-alist-exp t)) (goto-char ex-end) (when (<= current ex-beg) (setq ex-list (list ex-beg ex-end)) (throw 'found t)) (setq iden-flag nil)) ;; If no identifier is yet found, then next string is an ;; identifier. (skip-chars-forward "[a-zA-Z0-9_]") (setq iden-flag t))))))) ex-list)) (defun gams-store-point-inlinecom (limit) "Store points for font-lock for inline comment." (let (beg end flag) (when gams-inlinecom-symbol-start (catch 'found (while t (if (not (search-forward gams-inlinecom-symbol-start limit t)) (throw 'found t) (setq beg (match-beginning 0)) (when (not (gams-in-quote-p-extended)) (when (search-forward gams-inlinecom-symbol-end limit t) (setq end (match-end 0)) (when (not (gams-in-quote-p-extended)) (store-match-data (list beg end)) (setq flag t) (throw 'found t)))))))) flag)) (defun gams-store-point-eolcom (limit) "Store points for font-lock for end of line comment." (let (flag beg) (when gams-eolcom-symbol (catch 'found (while t (if (not (search-forward gams-eolcom-symbol limit t)) (throw 'found t) (setq beg (match-beginning 0)) (when (not (gams-in-quote-p-extended)) (end-of-line) (store-match-data (list beg (point))) (setq flag t) (throw 'found t)))))) flag)) (defun gams-store-point-mpsge-comment (limit) "Store points for font-lock for commented tex in MPSGE block." (let (flag beg) (catch 'found (while t (if (not (and (re-search-forward "[!]" limit t))) (throw 'found t) (setq beg (match-beginning 0)) (when (gams-in-mpsge-block-p) (when (not (gams-in-quote-p-extended)) (end-of-line) (store-match-data (list beg (point))) (setq flag t) (throw 'found t)))))) flag)) (setq gams-copied-program-regexp (gams-regexp-opt (list "E x e c u t i o n" "Model Statistics" "Solution Report" "C o m p i l a t i o n" "Equation Listing" "Column Listing" "Include File Summary" ) t)) (defun gams-store-point-copied-program (limit) "Store points for font-lock for copied program in LST mode." (let (flag cont) (when (re-search-forward "\\(^[ ]?[ ]?[ ]?[ ]?[ ]?[ ]?\\([0-9]+[ ][ ].*\\)\\|^\\(COMPILATION\\) TIME\\|^\\(Error\\) Messages\\|^\\(Include\\) File Summary\\|^\\(E x e c u t i o n\\)\\|^\\(Equation Listing\\)\\)" limit t) (setq cont (cond ((match-beginning 2) (buffer-substring (match-beginning 2) (match-end 2))) ((match-beginning 3) (buffer-substring (match-beginning 3) (match-end 3))) ((match-beginning 4) (buffer-substring (match-beginning 4) (match-end 4))) ((match-beginning 5) (buffer-substring (match-beginning 5) (match-end 5))) ((match-beginning 6) (buffer-substring (match-beginning 6) (match-end 5))))) (if (or (equal "COMPILATION" cont) (equal "Error" cont) (equal "Include" cont) (equal "E x e c u t i o n" cont)) (setq flag nil) (let ((beg (match-beginning 1)) (end (match-end 1))) (store-match-data (list beg end)) (setq flag t)))) flag)) ;;; Functions for changing font-lock level. (defun gams-update-font-lock-keywords (mode level) "Change the font lock level in MODE to LEVEL." (cond ((equal mode "g") (setq gams-font-lock-level level) (cond ((equal level 0) (setq gams-font-lock-keywords nil)) ((equal level 1) (setq gams-font-lock-keywords gams-font-lock-keywords-1)) ((equal level 2) (setq gams-font-lock-keywords gams-font-lock-keywords-2)))) ((equal mode "l") (setq gams-lst-font-lock-level level) (cond ((equal level 0) (setq gams-lst-font-lock-keywords nil)) ((equal level 1) (setq gams-lst-font-lock-keywords gams-lst-font-lock-keywords-1)) ((equal level 2) (setq gams-lst-font-lock-keywords gams-lst-font-lock-keywords-2)))) ((equal mode "o") (setq gams-ol-font-lock-level level) (cond ((equal level 0) (setq gams-ol-font-lock-keywords nil)) ((equal level 1) (setq gams-ol-font-lock-keywords gams-ol-font-lock-keywords-1)) ((equal level 2) (setq gams-ol-font-lock-keywords gams-ol-font-lock-keywords-2)))) )) (defun gams-check-font-lock-level-mode (&optional mode) "Check the font-lock level in MODE." (cond ((equal mode "g") gams-font-lock-level) ((equal mode "l") gams-lst-font-lock-level) ((equal mode "o") gams-ol-font-lock-level) (t (let ((cur-mode (gams-return-mode))) (cond ((equal cur-mode "g") gams-font-lock-level) ((equal cur-mode "l") gams-lst-font-lock-level) ((equal cur-mode "o") gams-ol-font-lock-level)))))) (defun gams-return-mode-name (&optional mode) "Return the mode name. If MODE is g, return GAMS mode, If MODE is l, return GAMS-LST mode, If MODE is o, return GAMS-OUTLINE mode. Otherwise, return the mode name of current buffer." (cond ((equal mode "g") "GAMS mode") ((equal mode "l") "GAMS-LST mode") ((equal mode "o") "GAMS-OUTLINE mode") (t mode-name))) (defun gams-return-mode () "Return the current mode name." (let ((cur-mode mode-name)) (cond ((equal cur-mode "GAMS") "g") ((equal cur-mode "GAMS-LST") "l") ((equal cur-mode "GAMS-OUTLINE") "o")))) (defun gams-choose-font-lock-level () "Choose the level of decoralization." (interactive) (let ((cur-mode (gams-return-mode)) (level 0) cur-level temp-mode) (message (format "Choose [g]ms, [l]st, [o]utline, RET = current mode.")) (let ((mode (char-to-string (read-char)))) (if (not (string-match "[glo\r]" mode)) (message "Push g, l, o, or RET!") (when (equal mode "\r") (setq mode (gams-return-mode))) (setq temp-mode (gams-return-mode-name mode)) (message (format "Current font-lock level in %s = %d: Choose 0, 1, or 2" temp-mode (setq cur-level (gams-check-font-lock-level-mode mode)))) (setq level (char-to-string (read-char))) (if (not (string-match "[012\r]" level)) (message "Type 0, 1, or 2!") (if (equal level "\r") (setq level (gams-check-font-lock-level-mode)) (setq level (string-to-number level))) (gams-choose-font-lock-level-internal level mode cur-mode) (message (format "The font-lock level in %s is changed from %d to %d." temp-mode cur-level level))))))) (defsubst gams-choose-font-lock-level-internal (level mode cur-mode) ;; Update keywords for font-lock. (gams-update-font-lock-keywords mode level) (cond ((equal mode "g") (setq font-lock-keywords gams-font-lock-keywords) (setq font-lock-defaults '(gams-font-lock-keywords t t))) ((equal mode "l") (setq font-lock-keywords gams-lst-font-lock-keywords) (setq font-lock-defaults '(gams-lst-font-lock-keywords t t))) ((equal mode "o") (setq font-lock-keywords gams-ol-font-lock-keywords) (setq font-lock-defaults '(gams-ol-font-lock-keywords t t)))) (when (equal cur-mode mode) (if (not (equal level 0)) (progn (font-lock-mode -1) (font-lock-mode 1) (when (not font-lock-fontified) (font-lock-fontify-buffer))) (font-lock-mode -1)))) (defun gams-in-declaration-p (&optional table) "Return t if the cursor is in declaration environment. Return nil if not in declaration environment. Return the starting point of the declaration if in declaration environment. If TABLE is nil, table declaration is not consindered as a declaration." (let ((cur-po (point)) (dummy (if table "dummy" "table")) temp-po beg-po temp-con) (save-excursion ;; Search reserved expression backward. (if (re-search-backward (concat "^[ \t]*\\(" gams-regexp-declaration-2 "\\|" gams-regexp-loop "\\|" gams-regexp-put "\\|" "[$][ \t]*" gams-regexp-mpsge "\\|$offtext\\|$ontext\\)") nil t) ;; Store the matched. (progn (setq temp-con (gams*buffer-substring (match-beginning 0) (match-end 0))) (setq temp-po (point)) (skip-chars-forward " \t") (forward-char 1) (cond ;; If the matched is table, do nothing. ((string-match dummy temp-con) t) ;; If the matched is declaration. ((string-match gams-regexp-declaration-2 temp-con) ;; Search ; forward. (let (flag) (catch 'found (while (re-search-forward ";" cur-po t) (when (and (not (gams-in-comment-p)) (not (gams-in-quote-p))) (setq flag t))) (throw 'found t)) (when (not flag) ;; If not found. (goto-char cur-po) ;; Move to the next line. (while (and (gams-check-line-type) (not (eobp))) (forward-line 1)) (when (not (eobp)) (when (not (looking-at (concat "^[ \t]*" gams-regexp-declaration-2))) (setq beg-po temp-po)))))))))) beg-po)) (defun gams-font-lock-mark-block-function () "The function for mark block in GAMS mode." (let ((cur-po (point)) (regexp (concat "^[ \t]*\\(" gams-regexp-declaration "\\|" gams-regexp-loop "\\|" gams-regexp-put "\\|" "[$][ \t]*" gams-regexp-mpsge "\\|$offtext\\|$ontext\\)"))) (push-mark (point)) (if (gams-in-on-off-text-p) (progn (re-search-forward "^$offtext" nil t) (push-mark (point) nil t) (re-search-backward "^$ontext" nil t) (goto-char (match-beginning 0))) (let ((count-1 4) (count-2 4)) (while (< 0 count-1) (if (re-search-forward regexp nil t) (setq count-1 (- count-1 1)) (setq count-1 -1))) (if (equal count-1 -1) (push-mark (point-max) nil t) (beginning-of-line) (when (gams-in-on-off-text-p) (re-search-backward "^$ontext" cur-po t)) (push-mark (point) nil t)) (goto-char cur-po) (while (< 0 count-2) (if (re-search-backward regexp nil t) (setq count-2 (- count-2 1)) (setq count-2 -1))) (if (equal count-2 -1) (goto-char (point-min)) (when (gams-in-on-off-text-p) (re-search-forward "^$offtext" cur-po t))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Code for GAMS mode. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun gams-insert-tab () "Insert a tab." (interactive) (insert "\t")) (setq-default gams-comment-prefix-default "*") (setq-default gams-comment-prefix gams-comment-prefix-default) ;; Key assignment. ;; from yatex.el ;; (defvar gams-prefix-key "\C-c" ;; "*Prefix key to call GAMS mode functions. ;; You can select favorite prefix key by setq in your ~/.emacs.el") (defvar gams-mode-map (make-keymap) "Keymap used in gams mode") ;; Key assignment. (defun gams-mode-key-update () (let ((map gams-mode-map)) (define-key map "(" 'gams-insert-parens) (define-key map "\"" 'gams-insert-double-quotation) (define-key map "'" 'gams-insert-single-quotation) (define-key map "\C-l" 'gams-recenter) (define-key map "\C-c\C-k" 'gams-insert-statement) (define-key map "\C-c\C-d" 'gams-insert-dollar-control) (define-key map "\C-c\C-v" 'gams-view-lst) (define-key map "\C-c\C-j" 'gams-jump-to-lst) (define-key map "\C-c\C-t" 'gams-start-menu) (define-key map "\C-c\C-e" 'gams-template) (define-key map "\C-c\C-o" 'gams-insert-comment) (define-key map "\C-c\C-g" 'gams-jump-on-off-text) (define-key map "\C-c\M-g" 'gams-remove-on-off-text) (define-key map "\C-c\M-c" 'gams-comment-on-off-text) (define-key map "\C-c\C-c" 'gams-insert-on-off-text) (define-key map "\C-c\C-m" 'gams-view-docs) (define-key map "\C-c\C-z" 'gams-modlib) (define-key map "\C-c\C-h" 'gams-toggle-hide/show-comment-lines) (define-key map "\C-c\C-l" 'gams-popup-process-buffer) (define-key map "\C-c\C-s" 'gams*start-processor) (define-key map [f9] 'gams*start-processor) (define-key map [f10] 'gams-view-lst) (define-key map "\C-c\C-i" 'gams-from-gms-to-outline) (define-key map [f11] 'gams-from-gms-to-outline) (define-key map [f8] 'gams-goto-matched-paren) (define-key map "\C-c\C-w" 'gams-open-included-file) (define-key map [(control c) (control \;)] 'gams-comment-region) (define-key map "\C-c.." 'gams-show-identifier) (define-key map [f7] 'gams-show-identifier) (define-key map "\C-c\C-a" 'gams-show-identifier-list) (define-key map gams-choose-font-lock-level-key 'gams-choose-font-lock-level) (define-key map "\M-;" 'gams-comment-dwim) (define-key map [(control c) (control \;)] 'gams-comment-dwim-inline))) ;;; Menu for GAMS mode. (easy-menu-define gams-menu gams-mode-map "Menu keymap for GAMS mode." '("GAMS" ["Insert GAMS statement" gams-insert-statement t] ["Insert GAMS dollar control" gams-insert-dollar-control t] ["Show the identifier declaration part" gams-show-identifier t] ["Show the identifier list" gams-show-identifier-list t] ["Open included file" gams-open-included-file t] "--" ["Switch to the LST file and show error" gams-view-lst t] ["Switch to the LST file" gams-jump-to-lst t] ["Switch to the GAMS-OUTLINE buffer" gams-from-gms-to-outline t] "--" ["Start GAMS-TEMPLATE mode" gams-template t] ["Insert a comment template" gams-insert-comment t] "--" ("Process" ["Run GAMS" (gams-start-menu nil ?s) t] ["Kill GAMS process" (gams-start-menu nil ?k) t] ["Process menu" (gams-start-menu) t] ) ["Run GAMS" gams*start-processor t] ["Popup GAMS process buffer" gams-popup-process-buffer t] "--" ["Choose font-lock level" gams-choose-font-lock-level t] ["Fontify block" font-lock-fontify-block t] "--" ["Insert an ontext-offtext pair" gams-insert-on-off-text t] ["Jump between an ontext-offtext pair" gams-jump-on-off-text t] ["(Un)comment an ontext-offtext pair" gams-comment-on-off-text t] ["Remove an ontext-offtext pair" gams-remove-on-off-text t] "--" ["Toggle hide/show comment blocks" gams-recenter t] ["Recentering" gams-recenter t] ["Indent line" gams-indent-line t] ["Indent region" indent-region t] ["Jump to the matched parenthesis" gams-goto-matched-paren t] "--" ["Insert end-of-line comment" gams-comment-dwim t] ["Insert inline comment" gams-comment-dwim-inline t] ["Comment out region" gams-comment-region t] "--" ["View GAMS manuals" gams-view-docs t] ["Extract a model from Model library" gams-modlib t] "--" ["Customize GAMS mode for Emacs" (customize-group 'gams) t] )) ;;; (defun gams-init-setting () "Make various settings for gams-mode." ;; Behavior of $ key. (if gams-insert-dollar-control-on (define-key gams-mode-map "$" 'gams-insert-dollar-control)) ;; Use automatic indent? (if gams-indent-on (progn (setq indent-line-function 'gams-indent-line) (define-key gams-mode-map "\t" 'gams-indent-line) (define-key gams-mode-map "\C-m" 'gams-newline-and-indent) (substitute-all-key-definition 'newline-and-indent 'gams-newline-and-indent gams-mode-map)) (define-key gams-mode-map "\t" 'gams-insert-tab) (define-key gams-mode-map "\C-m" 'newline)) ;; Make `gams-comment-prefix' a buffer-local variable. (let (temp) (if (setq temp (gams-search-dollar-comment)) (setq comment-prefix temp gams-comment-prefix temp comment-start temp comment-start-skip (concat "^[" temp "]+[ \t]*")) (setq comment-prefix gams-comment-prefix-default gams-comment-prefix gams-comment-prefix-default comment-start-skip (concat "^[" gams-comment-prefix-default "]+[ \t]*") comment-start gams-comment-prefix-default))) ;; Make `gams-eolcom-symbol' a buffer-local variable. (let (temp) (if (setq temp (gams-search-dollar-com t)) (setq gams-eolcom-symbol temp) (setq gams-eolcom-symbol gams-eolcom-symbol-default))) ;; Make `gams-inlinecom-symbol-start' and `gams-inlinecom-symbol-end' (let (temp) (if (setq temp (gams-search-dollar-com)) (progn (setq gams-inlinecom-symbol-start (car temp)) (setq gams-inlinecom-symbol-end (cdr temp))) (setq gams-inlinecom-symbol-start gams-inlinecom-symbol-start-default) (setq gams-inlinecom-symbol-end gams-inlinecom-symbol-end-default))) ;; Create the alist of statements. Is this necessary? See ;; `gams-statement-update'. (setq gams-statement-alist (gams-statement-to-alist gams-statement-up gams-statement-upcase)) ;; Create the alist of dollar control options. Is this necessary? See ;; `gams-statement-update'. (if gams-use-mpsge ;; Use mpsge. (progn (setq gams-dollar-control-alist (gams-statement-to-alist (append gams-dollar-control-up gams-statement-mpsge) gams-dollar-control-upcase))) ;; Not use mpsge (setq gams-dollar-control-alist (gams-statement-to-alist gams-dollar-control-up gams-dollar-control-upcase))) ;; Update statements and dollar control options. (gams-statement-update) ;; Update options. (gams-opt-make-alist) ;; Update commands. (gams-opt-make-alist t)) (setq-default gams-temp-window nil) (setq-default gams-ol-buffer-point nil) ;; (defun gams-mode () "Major mode for editing GAMS program file. The following commands are available in the GAMS mode: \\[gams-insert-statement] Insert GAMS statement with completion. \\[gams-insert-dollar-control] Insert GAMS dollar control option. \\[gams-show-identifier] Show the identifier declaration part. \\[gams-show-identifier-list] Show the identifier list. \\[gams-open-included-file] Open included file. \\[gams-view-lst] Switch to the LST file and show errors if exist. \\[gams-jump-to-lst] Switch to the LST file. \\[gams-from-gms-to-outline] Switch to the GAMS-OUTLINE buffer. \\[gams-start-menu] Run GAMS on a file you are editing or Kill GAMS process. \\[gams*start-processor] Run GAMS. \\[gams-popup-process-buffer] Popup GAMS process buffer. \\[gams-template] Evoke the TEMPLATE mode. \\[gams-recenter] Recenter. \\[gams-insert-comment] Insert comment template. \\[gams-insert-on-off-text] Insert an ontext-offtext pair. \\[gams-jump-on-off-text] Jump between an ontext-offtext pair. \\[gams-comment-on-off-text] (Un)comment an ontext-offtext pair. \\[gams-remove-on-off-text] Remove an ontext-offtext pair. \\[gams-view-docs] View GAMS pdf manuals. \\[gams-comment-dwim] Insert end-of-line comment. \\[gams-comment-dwim-inline] Insert inline comment." (interactive) (kill-all-local-variables) (setq major-mode 'gams-mode) (setq mode-name "GAMS") (gams-mode-key-update) (use-local-map gams-mode-map) (setq fill-prefix "\t\t") (mapcar 'make-local-variable '(fill-column fill-prefix paragraph-start indent-line-function comment-start comment-start-skip comment-column font-lock-mark-block-function gams-comment-prefix gams-eolcom-symbol gams-inlinecom-symbol-start gams-inlinecom-symbol-end gams-ol-buffer-point gams-gms-window-configuration gams-gms-original-point gams-identifier-symbol-temp comment-indent-function gams-invisible-exist-p gams-invisible-areas-list )) ;; Variables. (setq fill-column gams-fill-column fill-prefix gams-fill-prefix paragraph-start gams-paragraph-start comment-indent-function 'comment-indent-default comment-column gams-comment-column comment-end "" comment-start-skip (concat "^[" gams-comment-prefix "]+[ \t]*")) ;; Various setting. (gams-init-setting) ;; ;; (gams-create-syntax-table) ;; (set-syntax-table gams-mode-syntax-table) ;; Setting for font-lock. (make-local-variable 'font-lock-defaults) (gams-update-font-lock-keywords "g" gams-font-lock-level) (setq font-lock-defaults '(gams-font-lock-keywords t t)) (setq font-lock-mark-block-function 'gams-font-lock-mark-block-function) ;; Local variables to store window configurations. (make-local-variable 'gams-temp-window) ;; Setting for menu. (easy-menu-add gams-menu) ;; Run hook (run-hooks 'gams-mode-hook) (add-to-invisibility-spec '(gams . t)) (if (and (not (equal gams-font-lock-keywords nil)) font-lock-mode) (font-lock-fontify-buffer) (if (equal gams-font-lock-keywords nil) (font-lock-mode -1))) ) ;;; gams-mode ends. (defun gams-list-to-alist (list) "Trasform a LIST to an ALIST." (mapcar '(lambda (x) (list x)) list)) (defun gams-alist-to-list (alist) "Trasform an ALIST to a LIST." (mapcar '(lambda (x) (car x)) alist)) (defun gams-statement-to-alist (list &optional flag) "Transform a LIST to an alist. IF FLAG is non-nil, use upper case." (if (not flag) (setq list (mapcar 'downcase list)) nil) (mapcar '(lambda (x) (list x)) list)) ;; `gams-comment-region' is aliased as `comment-region'. (if (fboundp 'comment-region) (fset 'gams-comment-region 'comment-region) (fset 'gams*buffer-substring 'buffer-substring)) (defvar gams-statement-alist-temp nil) (defvar gams-dollar-alist-temp nil) (defun gams-statement-update () "Update gams-statement-alist and gams-dollar-control-alist." ;; Update `gams-statement-alist'. (setq gams-statement-alist (gams-statement-to-alist (append gams-statement-up gams-user-statement-list) gams-statement-upcase)) ;; Update `gams-dollar-control-alist'. (setq gams-dollar-control-alist (gams-statement-to-alist ;; If you use MPSGE (if gams-use-mpsge (append gams-dollar-control-up gams-statement-mpsge gams-user-dollar-control-list) (append gams-dollar-control-up gams-user-dollar-control-list)) gams-dollar-control-upcase))) ;;; From yatex.el (defun gams-minibuffer-complete () "Complete in minibuffer. If the symbol 'delim is bound and is string, its value is assumed to be the character class of delimiters. Completion will be performed on the last field separated by those delimiters. If the symbol 'quick is bound and is 't, when the try-completion results in t, exit minibuffer immediately." (interactive) (save-restriction (narrow-to-region (if (fboundp 'field-beginning) (field-beginning (point-max)) (point-min)) (point-max)) (let* ((md (match-data)) beg word comp delim compl (quick (and (boundp 'quick) (eq quick t))) (displist ;function to display completion-list (function (lambda () (with-output-to-temp-buffer "*Completions*" (display-completion-list (all-completions word minibuffer-completion-table))))))) (setq beg (if (and (boundp 'delim) (stringp delim)) (save-excursion (skip-chars-backward (concat "^" delim)) (point)) (point-min)) word (gams*buffer-substring beg (point-max)) compl (try-completion word minibuffer-completion-table)) (cond ((eq compl t) (if quick (exit-minibuffer) (let ((p (point)) (max (point-max))) (unwind-protect (progn (goto-char max) (insert " [Sole completion]") (goto-char p) (sit-for 1)) (delete-region max (point-max)) (goto-char p))))) ((eq compl nil) (ding) (save-excursion (let (p) (unwind-protect (progn (goto-char (setq p (point-max))) (insert " [No match]") (goto-char p) (sit-for 2)) (delete-region p (point-max)))))) ((string= compl word) (funcall displist)) (t (delete-region beg (point-max)) (insert compl) (if quick (if (eq (try-completion compl minibuffer-completion-table) t) (exit-minibuffer) (funcall displist))))) (store-match-data md)))) (defvar gams-statement-completion-map nil "*Key map used at gams completion of statements in the minibuffer.") (if gams-statement-completion-map nil (setq gams-statement-completion-map (copy-keymap minibuffer-local-completion-map)) (define-key gams-statement-completion-map " " 'minibuffer-complete) (define-key gams-statement-completion-map "\C-i" 'minibuffer-complete-word)) ;;; ??? (defvar gams-read-statement-history nil "Holds history of statement.") (put 'gams-read-statement-history 'no-default t) (defun gams-read-statement (prompt &optional predicate initial) "Read a GAMS statements with completion." ; (YaTeX-sync-local-table 'tmp-section-table) (let ((minibuffer-completion-table gams-statement-alist)) (read-from-minibuffer prompt initial gams-statement-completion-map nil 'gams-read-statement-history))) (defun gams-register (name &optional flag) "Register a new statement or dollar-control. NAME is the name of a new statement or dollar-control registered. If FLAG is non-nil, it is a dollar-control." (interactive) (let* ((curr-buff (current-buffer)) (temp-buff " *gams-register*") (temp-file gams-statement-file) (temp-list (if flag gams-user-dollar-control-list gams-user-statement-list)) (old-list temp-list) (list-name (if flag "gams-user-dollar-control-list" "gams-user-statement-list")) temp-cont new-list) (save-excursion ;; Make a new list. (setq new-list (append (list name) temp-list)) ;; Switch to the temporary buffer. (get-buffer-create temp-buff) (set-buffer temp-buff) (erase-buffer) ;; Write the content of the list. (gams-stat-write-list new-list flag) ;; Check whether the variable is defined correctly. (eval-buffer) ;; Store the content of buffer (setq temp-cont (gams*buffer-substring (point-min) (point-max))) ;; Delete the list-name part. (set-buffer (find-file-noselect temp-file)) (goto-char (point-min)) ;; Check whether the list-name part exists or not. (if (not (re-search-forward (concat "\\(setq\\) " list-name) nil t)) ;; If it doesn't exists, do nothing. nil ;; If it exists, delete it. (let (point-beg point-en) (goto-char (match-beginning 1)) (beginning-of-line) (setq point-beg (point)) (forward-sexp 1) (forward-line 1) (setq point-en (point)) (delete-region point-beg point-en))) ;; Insert the content. (goto-char (point-min)) (insert temp-cont) (eval-buffer) ;; Save buffer of gams-statement-file. (save-buffer (find-buffer-visiting temp-file)) (kill-buffer (find-buffer-visiting temp-file)) ;; kill the temporary buffer. (kill-buffer temp-buff) ;; Replace the old list with the new list. (setq old-list new-list) (gams-statement-update) (set-buffer curr-buff)))) (defun gams-stat-write-list (list &optional flag) "Write the content of LIST in a buffer. If FLAG is non-nil, the list of dollar control." (let ((list-name (if flag "gams-user-dollar-control-list" "gams-user-statement-list"))) (erase-buffer) (insert (concat "(setq " list-name " '(\n")) (goto-char (point-max)) ;; Repeat. (while list (insert (concat "\"" (car list) "\"\n")) (goto-char (point-max)) (setq list (cdr list))) ;; Last. (insert "))\n"))) (defun gams-insert-statement-get-name (&optional replace) "Get the name of satement inserted." (let ((mess (if replace (concat "Replace `" replace "' with ") "Insert statement ")) name guess) (setq guess (if gams-statement-upcase (upcase gams-statement-name) (downcase gams-statement-name))) (setq name (gams-read-statement (concat mess (format "(default = %s): " guess)))) (if (string= name "") guess name))) (defun gams-insert-statement (&optional arg) "Insert GAMS statement with completion. List of candidates is created from elements of `gams-statement-up' and `gams-user-statement-list'." (interactive "P") (if arg (gams-replace-statement) (gams-insert-statement-internal))) (defun gams-insert-statement-internal (&optional cmd) "Insert GAMS statement with completion. List of candidates is created from elements of `gams-statement-up' and `gams-user-statement-list'." ;; (interactive) (unwind-protect (let* ((gams-alist gams-statement-alist) (completion-ignore-case t) key1 (source-window (selected-window)) guess (statement (or cmd (gams-insert-statement-get-name))) ) ;;let (if gams-statement-upcase (setq statement (upcase statement)) (setq statement (downcase statement))) (setq gams-statement-name statement) ;; Register or not? (if (not (member (list statement) gams-statement-alist)) (progn (message "Store `%s' for future use? Type `y' if yes: " statement) (setq key1 (read-char)) (if (equal key1 ?y) (progn (setq statement (upcase statement)) (gams-register statement)) nil)) nil) ;; Insert. (if gams-statement-upcase (setq statement (upcase statement)) (setq statement (downcase statement))) (insert statement)) (if (<= (minibuffer-depth) 0) (use-global-map global-map)) (insert ""))) (defvar gams-dollar-completion-map nil "*Key map used at gams completion of dollar operation in the minibuffer.") (if gams-dollar-completion-map nil (setq gams-dollar-completion-map (copy-keymap minibuffer-local-completion-map)) (define-key gams-dollar-completion-map " " 'minibuffer-complete) (define-key gams-dollar-completion-map "\C-i" 'minibuffer-complete-word) (define-key gams-dollar-completion-map "$" 'gams-minibuffer-insert-dollar) (define-key gams-dollar-completion-map "@" 'gams-minibuffer-insert-dollar)) (defvar gams-flag-dollar nil) (defun gams-minibuffer-insert-dollar () "???" (interactive) (setq gams-flag-dollar t) (exit-minibuffer)) (defvar gams-read-dollar-history nil "Holds history of dollar control.") (put 'gams-read-dollar-history 'no-default t) (defun gams-read-dollar-control (prompt &optional predicate initial) "Read a GAMS dollar control operation with completion." (let ((minibuffer-completion-table (append gams-dollar-control-alist))) (read-from-minibuffer prompt initial gams-dollar-completion-map nil 'gams-read-dollar-history))) (defun gams-insert-dollar-control-get-name (&optional replace) "Get the name of dollar-control inserted." (let ((mess (if replace (concat "Replace `$" replace "' with ") "Insert dollar control ")) name guess) (setq guess (if gams-dollar-control-upcase (upcase gams-dollar-control-name) (downcase gams-dollar-control-name))) (setq name (gams-read-dollar-control (if gams-insert-dollar-control-on (concat mess (format " ($ or @ = $, default = $%s): $" guess)) (concat mess (format " (default = $%s): $" guess))))) (setq name (if (string= name "") guess name)) (setq name (if gams-flag-dollar "" name)) name)) (defun gams-insert-dollar-control (&optional arg) "Insert GAMS dollar control option with completion. List of candidates is created from elements of `gams-dollar-control-up' and `gams-user-dollar-control-list' (and `gams-statement-mpsge' if `gams-use-mpsge' is non-nil)." (interactive "P") (if arg (gams-replace-statement) (gams-insert-dollar-control-internal))) (defun gams-insert-dollar-control-internal (&optional cmd) "Insert GAMS dollar control option with completion. List of candidates is created from elements of `gams-dollar-control-up' and `gams-user-dollar-control-list' (and `gams-statement-mpsge' if `gams-use-mpsge' is non-nil)." ;; Need to modify this. (setq gams-flag-dollar nil) (unwind-protect (let* ((gams-alist gams-dollar-control-alist) (completion-ignore-case t) key1 (source-window (selected-window)) guess (statement (or cmd (gams-insert-dollar-control-get-name))) );;let (if (not (equal statement "")) (setq gams-dollar-control-name statement)) (if gams-dollar-control-upcase (setq statement (upcase statement)) (setq statement (downcase statement))) ;; Register or not? (if (not (or (member (list statement) gams-dollar-control-alist) (equal statement ""))) (progn (message "Store `%s' for future use? Type `y' if yes: " statement) (setq key1 (read-char)) (if (equal key1 ?y) (progn (setq statement (upcase statement)) (gams-register statement t)) nil)) nil) ;; Insert. (if gams-dollar-control-upcase (setq statement (upcase statement)) (setq statement (downcase statement))) (insert (concat "$" statement))) (if (<= (minibuffer-depth) 0) (use-global-map global-map)) (insert ""))) ;insert dummy string to fontify(Emacs20) (defun gams-get-lst-filename () "Return the LST file name corresponding to the current GMS file buffer." (let ((file-buffer-gms (buffer-file-name)) (ext-up (concat "." (upcase gams-lst-extention))) (ext-down (concat "." (downcase gams-lst-extention))) dir-gms file-noext file-lst file-gms) ;; Store the GMS file name. (setq dir-gms (file-name-directory file-buffer-gms)) (setq file-gms (file-name-nondirectory file-buffer-gms)) (setq file-noext (file-name-sans-extension file-gms)) ;; Search the LST file name (cond ((file-exists-p (concat dir-gms (upcase file-noext) ext-up)) (setq file-lst (concat dir-gms (upcase file-noext) ext-up))) ((file-exists-p (concat dir-gms file-noext ext-down)) (setq file-lst (concat dir-gms file-noext ext-down))) ((file-exists-p (concat dir-gms file-noext ext-up)) (setq file-lst (concat dir-gms file-noext ext-up))) ((file-exists-p (concat dir-gms (upcase file-noext) ext-down)) (setq file-lst (concat dir-gms (upcase file-noext) ext-down))) ((file-exists-p (concat dir-gms (downcase file-noext) ext-down)) (setq file-lst (concat dir-gms (downcase file-noext) ext-down))) ((file-exists-p (concat dir-gms (downcase file-noext) ext-up)) (setq file-lst (concat dir-gms (downcase file-noext) ext-up))) (t (message "LST file does not exist!"))) ;; Return the name. file-lst)) (defun gams-view-lst () "Switch to the LST file buffer and show the error message." (interactive) (let ((file-lst (gams-get-lst-filename))) (if file-lst ;; If the LST file exists. (progn (let ((lst-buffer)) (if (find-buffer-visiting file-lst) ;; If file-lst is already opened. (progn (set-buffer (find-buffer-visiting file-lst)) (if (verify-visited-file-modtime (current-buffer)) ;; If lst file is not changed (progn (switch-to-buffer (current-buffer)) ;; View error. (gams-lst-view-error)) ;; If lst file is chenged, kill-buffer. (set-buffer-modified-p nil) (kill-buffer (find-buffer-visiting file-lst)) (find-file file-lst) (goto-char (point-min)) (gams-lst-mode) (gams-lst-view-error))) ;; if file-lst isn't opened. (find-file file-lst) (goto-char (point-min)) (gams-lst-mode) (gams-lst-view-error)))) ;; If the LST file not exits. (message "The LST file does not exist!") nil))) (defun gams-jump-to-lst () "Switch to the LST file buffer." (interactive) (let ((file-lst (gams-get-lst-filename))) (if file-lst ;; If lst file exists (progn (let ((lst-buffer)) ;; lst file is already opened? (if (find-buffer-visiting file-lst) ;; If file-lst is already opened. ;; lst file is modified? (if (verify-visited-file-modtime (find-buffer-visiting file-lst)) ;; If not modified. (pop-to-buffer (find-buffer-visiting file-lst)) ;; If modified. (set-buffer-modified-p nil) (kill-buffer (find-buffer-visiting file-lst)) (find-file file-lst) (gams-lst-mode)) ;; If file-lst isn't opened, open it. (find-file file-lst) (gams-lst-mode))) (recenter)) ;; LST file does not exits. (message "The LST file does not exist!")))) ;;; Comment insertion. (defun gams-insert-comment () "Insert a comment template defined by `gams-user-comment'." (interactive) (let ((use-comment gams-user-comment) point-b point-c) (save-excursion (insert gams-user-comment) (setq point-b (point))) (when (re-search-forward "%" point-b t) (replace-match "")))) ;;;;; fill-paragraph. ;;; Fill paragraph function. This is from "lisp-mode.el" ;;; (`lisp-fill-paragraph'). I changed ";" in the original function to ;;; "\\(*\\)". This function is likely not to work well in many cases. (defun gams-fill-paragraph (&optional justify) "Like \\[fill-paragraph], but handle GAMS comment. If any of the current line is a comment, fill the comment or the paragraph of it that point is in, preserving the comment's indent and initial *." (interactive "P") (let ( ;; Non-nil if the current line contains a comment. has-comment ;; Non-nil if the current line contains code and a comment. has-code-and-comment ;; If has-comment, the appropriate fill-prefix for the comment. comment-fill-prefix ) ;; Figure out what kind of comment we are looking at. (setq paragraph-start gams-paragraph-start) (message paragraph-start) (save-excursion (beginning-of-line) (cond ;; A line with nothing but a comment on it? ((looking-at (concat "^\\([" gams-comment-prefix "]\\)[" gams-comment-prefix " \t]*")) (setq has-comment t comment-fill-prefix (gams*buffer-substring (match-beginning 0) (match-end 0)))) ;; A line with some code, followed by a comment? Remember that the ;; semi which starts the comment shouldn't be part of a string or ;; character. ;; ((condition-case nil ;; (save-restriction ;; (narrow-to-region (point-min) ;; (save-excursion (end-of-line) (point))) ;; (while (not (looking-at ";\\|$")) ;; (skip-chars-forward "^;\n\"\\\\?") ;; (cond ;; ((eq (char-after (point)) ?\\) (forward-char 2)) ;; ((memq (char-after (point)) '(?\" ??)) (forward-sexp 1)))) ;; (looking-at ";+[\t ]*")) ;; (error nil)) ;; (setq has-comment t has-code-and-comment t) ;; (setq comment-fill-prefix ;; (concat (make-string (/ (current-column) 8) ?\t) ;; (make-string (% (current-column) 8) ?\ ) ;; (buffer-substring (match-beginning 0) (match-end 0))))) )) (if (not has-comment) ;; `paragraph-start' is set here (not in the buffer-local ;; variable so that `forward-paragraph' et al work as ;; expected) so that filling (doc) strings works sensibly. ;; Adding the opening paren to avoid the following sexp being ;; filled means that sexps generally aren't filled as normal ;; text, which is probably sensible. The `;' and `:' stop the ;; filled para at following comment lines and keywords ;; (typically in `defcustom'). (let ((paragraph-start (concat paragraph-start "")) ;; (let ((paragraph-start "[\t\n\f]") (temp-po (gams-in-on-off-text-p)) beg end) (if temp-po (save-restriction (narrow-to-region (car temp-po) (car (cdr temp-po))) (fill-paragraph justify)) (fill-paragraph justify))) ;; Narrow to include only the comment, and then fill the region. (save-excursion (save-restriction (beginning-of-line) (narrow-to-region ;; Find the first line we should include in the region to fill. (save-excursion (while (and (zerop (forward-line -1)) (looking-at (concat "^\\([" gams-comment-prefix "]\\)")))) ;; We may have gone too far. Go forward again. (or (looking-at (concat "^\\([" gams-comment-prefix "]\\)")) (forward-line 1)) (point)) ;; Find the beginning of the first line past the region to fill. (save-excursion (while (progn (forward-line 1) (looking-at (concat "^\\([" gams-comment-prefix "]\\)")))) (point))) ;; Lines with only * on them can be paragraph boundaries. (let* ((paragraph-start (concat paragraph-start "\\|^\\([" gams-comment-prefix "]\\)$")) (paragraph-separate (concat paragraph-start "\\|^\\([" gams-comment-prefix "]\\)$")) (paragraph-ignore-fill-prefix nil) (fill-prefix comment-fill-prefix) (after-line (if has-code-and-comment (save-excursion (forward-line 1) (point)))) (end (progn (forward-paragraph) (or (bolp) (newline 1)) (point))) ;; If this comment starts on a line with code, ;; include that like in the filling. (beg (progn (backward-paragraph) (if (eq (point) after-line) (forward-line -1)) (point)))) (fill-region-as-paragraph beg end justify nil (save-excursion (goto-char beg) (if (looking-at fill-prefix) nil (re-search-forward comment-start-skip) (point)))))))) t)) ;;; Process handling. ;;; Most of the codes for process handling are from epo.el, epolib.el, ;;; epop.el in the `EPO' package written by Yuuji Hirose. I modified ;;; them. ;;; From epolib.el (defun gams*window-list () "Return visible window list." (let* ((curw (selected-window)) (win curw) (wlist (list curw))) (while (not (eq curw (setq win (next-window win)))) (or (eq win (minibuffer-window)) (setq wlist (cons win wlist)))) wlist)) (defun gams*smart-split-window (height) "Split current window wight specified HEIGHT. If HEIGHT is number, make a new window that has HEIGHT lines. If HEIGHT is string, make a new window that occupies HEIGT % of screen height. Otherwise split window conventionally." (if (one-window-p t) (split-window (selected-window) (max (min (- (gams*screen-height) (if (numberp height) (+ height 2) (/ (* (gams*screen-height) (string-to-int height)) 100))) (- (gams*screen-height) window-min-height 1)) window-min-height)))) (defun gams*process-caluculate-time (begtime) "Calculate time from BEGTIME to now and return it." (let ((curr-time (floor (- (string-to-number (format-time-string "%s")) begtime))) hour mini seco) (setq curr-time (or curr-time 0)) (setq hour (number-to-string (/ curr-time 3600)) curr-time (% curr-time 3600) mini (number-to-string (/ curr-time 60)) seco (number-to-string (% curr-time 60))) (when (equal (length hour) 1) (setq hour (concat "0" hour))) (when (equal (length mini) 1) (setq mini (concat "0" mini))) (when (equal (length seco) 1) (setq seco (concat "0" seco))) (list hour mini seco))) (defcustom gams-process-log-to-file nil "If non-nil, GAMS log (the content of process buffer) is written down to log file." :type 'boolean :group 'gams) (defcustom gams-log-file-extension "log" "The extension of log file." :type 'string :group 'gams) ;;; From epop.el (defun gams*process-sentinel (proc mess) "Display the end of process buffer." (cond ((memq (process-status proc) '(signal exit)) (save-excursion (let ((sw (selected-window)) w err curr-time temp) (set-buffer (process-buffer proc)) (goto-char (point-max)) (insert (format "\nGAMS process finished at %s\n" (current-time-string))) (setq temp (gams*process-caluculate-time gams-ps-compile-start-time)) (insert (format "Total compilation time is %s:%s:%s.\n" (car temp) (nth 1 temp) (nth 2 temp))) (setq gams-ps-compile-start-time 0) (when gams-process-log-to-file (let* ((gms-file (buffer-file-name gams-ps-gms-buffer)) (log-file (concat (expand-file-name (file-name-sans-extension gms-file)) "." gams-log-file-extension))) (write-region (point-min) (point-max) log-file))) (when (not gams-xemacs) (modify-frame-parameters gams-ps-frame (list (cons 'name gams-ps-orig-frame-title)))) (setq err (gams-process-error-exist-p)) (cond ((and gams:frame-feature-p (setq w (get-buffer-window (current-buffer) t))) (select-frame (window-frame w)) (select-window w) (goto-char (point-max)) (recenter -1)) ((setq w (get-buffer-window (current-buffer))) (select-window w) (goto-char (point-max)) (recenter -1))) (select-window sw) (if err (message (concat (format "GAMS ended with `%s' errors! " err) "C-cC-v or [F10]= LST file.")) (message (concat "GAMS process has finished. " "C-cC-v or [F10]= LST file, [F11]= OUTLINE.")))))))) (defun gams-process-error-exist-p () "Judge whether GAMS process ends with errors." (let (flag) (save-excursion (goto-char (point-min)) (when (re-search-forward "\\*\\*\\* Status: \\([a-zA-Z]+\\) error" nil t) (setq flag (gams*buffer-substring (match-beginning 1) (match-end 1))))) flag)) ;;; New function. (defun gams-popup-process-buffer (&optional select) "Popup the GAMS process buffer. Moreover, If you attach the universal-argument or if the process buffer is already popped up, then move to the process buffer." (interactive "P") (let ((pbuff (gams-get-process-buffer))) (if (get-buffer pbuff) (gams*showup-buffer pbuff select) (message "There is no GAMS process buffer associated with this buffer!")))) (defun gams*showup-buffer (buffer &optional select) "Make BUFFER show up in certain window (except selected window). Non-nil for optional argument SELECT keeps selection to the target window." (let (w) (if (setq w (get-buffer-window buffer)) ;; Already visible, just select it. (select-window w) ;; Not visible (let ((sw (selected-window)) (wlist (gams*window-list))) (cond ((eq (current-buffer) (get-buffer buffer)) nil) ((one-window-p) (gams*smart-split-window gams-default-pop-window-height) (select-window (next-window nil 1)) (switch-to-buffer (get-buffer-create buffer)) (recenter -1)) ;; (other-window 1)) ((= (length wlist) 2) (select-window (get-lru-window)) (switch-to-buffer (get-buffer-create buffer))) (t ;more than 2windows (select-window (next-window nil 1)) (switch-to-buffer (get-buffer-create buffer)))) (or select (select-window sw)))))) (setq-default gams-ps-gms-buffer nil) (setq-default gams-ps-compile-start-time nil) (defun gams*start-process-other-window (name commandline) "Start command line (via shell) in the next window." (let ((sw (selected-window)) (cur-buff (current-buffer)) p (dir default-directory) pbuff-name) (setq pbuff-name (gams-get-process-buffer)) (if gams-always-popup-process-buffer (gams*showup-buffer pbuff-name t) ;popup buffer and select it. (set-buffer (get-buffer-create pbuff-name))) (current-buffer) ;; for debug. (gams-ps-mode) (setq gams-ps-gms-buffer cur-buff) (erase-buffer) (cd dir) (setq default-directory dir) (insert commandline "\n") (insert (format "Start at %s\n\n " (current-time-string))) (setq gams-ps-compile-start-time (string-to-number (format-time-string "%s"))) (goto-char (point-max)) (set (make-local-variable 'gams:process-command-name) name) (set-process-sentinel (setq p (start-process name pbuff-name shell-file-name gams:shell-c commandline)) 'gams*process-sentinel) (if (and (not gams-xemacs) gams-use-process-filter) (set-process-filter p 'gams*process-filter) (set-process-filter p nil)) (message "Running GAMS. Type C-cC-l to popup the GAMS process buffer.") (set-marker (process-mark p) (1- (point))) (select-window sw))) (defvar gams-ps-mode-map (make-keymap) "Keymap used in gams ps mode") (define-key gams-ps-mode-map "\C-c\C-l" 'gams-ps-back-to-gms) ;;; New variable. (defvar gams-use-process-filter nil "Non-nil means use the process output filter.") (setq gams-use-process-filter nil) (defun gams*process-filter (proc string) (let ((p-buff (process-buffer proc)) po-beg po-end po-pair m title) (save-excursion (set-buffer p-buff) (setq m (point-marker)) (goto-char (point-max)) (backward-char 1) (insert string) (when (and (setq po-beg (string-match "[[]" string)) (setq po-end (string-match "[]]" string))) (setq title (substring string (1+ po-beg) po-end)) (modify-frame-parameters gams-ps-frame (list (cons 'name title)))) (goto-char (marker-position m)) (set-marker m nil)))) (setq-default gams-ps-frame nil) (setq-default gams-ps-orig-frame-title nil) (define-derived-mode gams-ps-mode fundamental-mode "GAMS-PS" "Mode for GAMS process buffer." (kill-all-local-variables) (setq major-mode 'gams-ps-mode) (setq mode-name "GAMS-PS") (mapcar 'make-local-variable '(gams-ps-compile-start-time gams-ps-gms-buffer)) (use-local-map gams-ps-mode-map) (when (not gams-xemacs) (make-local-variable 'gams-ps-orig-frame-title) (setq gams-ps-orig-frame-title (frame-parameter nil 'name)) (make-local-variable 'gams-ps-frame) (setq gams-ps-frame (selected-frame))) (setq font-lock-mode nil) ) (defun gams-ps-back-to-gms () "Jump back to gms buffer from GAMS process buffer." (interactive) (let ((gw (get-buffer-window gams-ps-gms-buffer))) (if gw (select-window gw) (delete-other-windows) (gams*smart-split-window gams-default-pop-window-height) (switch-to-buffer gams-ps-gms-buffer) (recenter)))) (defun gams*get-builtin (keyword) "Get built-in string specified by KEYWORD in current buffer." (save-excursion (save-restriction (widen) (goto-char (point-min)) (if (search-forward (concat comment-start ;buffer local variable in any buffer keyword) nil t) (let ((peol (progn (end-of-line) (point)))) (gams*buffer-substring (progn (goto-char (match-end 0)) (skip-chars-forward " \t") (point)) (if (and comment-end (stringp comment-end) (string< "" comment-end) (re-search-forward (concat (regexp-quote comment-end) "\\|$") peol 1)) (match-beginning 0) peol))))))) (defun gams*update-builtin (keyword newdef) "Update built-in KEYWORD to NEWDEF" (save-excursion (save-restriction (widen) (goto-char (point-min)) (if (search-forward (concat comment-start keyword) nil t) (let ((peol (progn (end-of-line) (point)))) (goto-char (match-end 0)) (skip-chars-forward " \t") (delete-region (point) (if (and comment-end (stringp comment-end) (string< "" comment-end) (search-forward comment-end peol t)) (progn (goto-char (match-beginning 0)) (point)) peol)) (insert newdef)) (while (and (progn (skip-chars-forward " \t") (looking-at (regexp-quote comment-start))) (not (eobp))) (forward-line 1)) (open-line 1) (insert comment-start keyword newdef comment-end))))) (defun gams-get-program-filename (&optional nodir noext) "" (cond ((and nodir (not noext) (file-name-nondirectory (buffer-file-name (current-buffer))))) ((and (not nodir) noext) (file-name-sans-extension (buffer-file-name (current-buffer)))) ((and nodir noext) (file-name-nondirectory (file-name-sans-extension (buffer-file-name (current-buffer))))) (t (buffer-file-name (current-buffer))))) (defun gams-get-process-buffer () "Create the name of GAMS process buffer for the current buffer." (if gams-multi-process ;; Multi-process. (concat gams*command-process-buffer " on " (gams-get-program-filename t) "*") ;; Not multi-process. (concat gams*command-process-buffer "*"))) (defun gams*start-processor (&optional ask) "Start GAMS on the current file." (interactive) (let* (prompt (builtin "#!") (command "compile") arg string newarg) (setq arg (or ;; if built-in processor specified, use it (and builtin (gams*get-builtin builtin)) (concat (gams-opt-return-option t) " " (file-name-nondirectory buffer-file-name) " " (gams-opt-return-option)))) (basic-save-buffer) ;(setq arg (concat command " " arg)) (gams*start-process-other-window command (cond (prompt (read-string "Execute: " arg)) (ask (setq newarg (read-string "Edit command if you want: " arg)) (if (and builtin (not (string= newarg arg)) (y-or-n-p "Use this command line also in the future? ")) (progn (gams*update-builtin builtin newarg) (message "The command line is inserted in the fisrt line in this file!"))) newarg) (t arg))))) (defun gams*kill-processor () "Stop (kill) a GAMS process." (interactive) (let ((p (get-buffer-process (get-buffer-create (gams-get-process-buffer))))) (if p (progn (kill-process p) (message "GAMS process was interrupted.")) (message "GAMS process has already exited.")))) (defun gams-start-menu (&optional ask char) "Evoke the GAMS process menu. Optional second argument CHAR is for non-interactive call from menu." (interactive "P") (message (format "Start GAMS (%c), Kill GAMS process (%c), Change GAMS command (%c), Change options (%c)." gams-run-key gams-kill-key gams-change-command-key gams-option-key)) (let ((c (or char (read-char)))) (cond ((equal c gams-run-key) (gams*start-processor ask)) ((equal c gams-kill-key) (gams*kill-processor)) ((equal c gams-option-key) (gams-option)) ((equal c gams-change-command-key) (gams-change-gams-command)) (t (message "No such choice `%c'" c))))) (defun gams-recenter () "Recentering." (interactive) (when (and font-lock-mode gams-recenter-font-lock (not gams-xemacs)) (font-lock-fontify-block)) (recenter)) ;;; View manuals. (defvar gams-read-docs-history nil "Holds history of dollar control.") (put 'gams-read-dollar-history 'no-default t) (defvar gams-read-doc-completion-map nil "*Key map for gams-read-docs.") (if gams-read-doc-completion-map nil (setq gams-read-doc-completion-map (copy-keymap minibuffer-local-completion-map)) (define-key gams-read-doc-completion-map " " 'minibuffer-complete) (define-key gams-read-doc-completion-map "\C-i" 'minibuffer-complete)) (defun gams-read-docs (prompt &optional predicate initial) "Read a GAMS dollar control operation with completion." (let ((minibuffer-completion-table (append gams-manuals-alist))) (read-from-minibuffer prompt initial gams-read-doc-completion-map nil 'gams-read-docs-history))) (defvar gams-manuals-alist (if gams-win32 (append gams-manuals-alist-base '(("McCarl-User-Guide-chm" . "mccarlgamsuserguide.chm") ("Ask-Tool-chm" . "ask.chm") ("GAMSIDE-Tool-chm" . "gamside.chm") ("GDX2ACESS-Tool-chm" . "gdx2access.chm") ("GDXUTILS-Tool-chm" . "gdxutils.chm") ("GDXVIEWER-Tool-chm" . "gdxviewer.chm") ("MDB2GMS-Tool-chm" . "mdb2gms.chm") ("SHELLEXECUTE-Tool-chm" . "shellexecute.chm") ("SQL2GMS-Tool-chm" . "sql2gms.chm") ("XLS2GMS-Tool-chm" . "xls2gms.chm"))) gams-manuals-alist-base) "Alist of the name of GAMS manual files and its abbreviated name (label). This list is created from GAMS 22.5 windows version..pdf") (defun gams-view-docs () "View GAMS manuals. Envoke the PDF file (or windows help file) viewer and see GAMS manuals. The viewer is determined by the variable `gams-docs-view-program'. The directory of GAMS documents is determined by the variable `gams-docs-directory'. By default, `gams-docs-directory' is set to `gams-system-directory' + docs. The list of documents displayed as candidates is created from GAMS ver 22.5 for windows. If you use other version of GAMS, some documents may not be available on you system." (interactive) (unwind-protect (let* ((completion-ignore-case t) (docs-dir (file-name-as-directory gams-docs-directory)) (source-window (selected-window)) guess (statement (progn (setq guess "User-Manual") (gams-read-docs (format "View which manual? (default = %s): " guess)))) (statement (if (string= statement "") guess statement)) file-name file-name-full (buf (get-buffer-create "*View GAMS manual*")) proc ) ;;let* ends. (setq file-name (assoc statement gams-manuals-alist)) (if (not file-name) (message "Enter the registered label.") (setq file-name-full (car (find-lisp-find-files docs-dir (cdr file-name)))) (if (not file-name-full) (message (format "Manual file for %s is not found." statement)) ;; Start process. (setq proc (start-process "manual" buf gams-docs-view-program file-name-full)) (message "Starting manual viewer...") ))))) ;;; New command. (defun gams-from-gms-to-outline () "Jump directly to the OUTLINE buffer from gms file buffer. If any errors exists, just move to the LST buffer." (interactive) (when (gams-view-lst) (gams-outline))) ;;;;; Commands for ontext-offtext pair. (defun gams-insert-on-off-text (arg) "Insert an ontext-offtext pair. If you attach universal-argument, this encloses the specified region with an ontext-offtext pair." (interactive "p") (let* ((up (if gams-dollar-control-upcase t nil)) (on-string (if up "$ONTEXT" "$ontext")) (off-string (if up "$OFFTEXT" "$offtext"))) (if (equal arg 1) ;; No universal argument. (progn (beginning-of-line) (insert (concat on-string "\n\n" off-string "\n")) (forward-line -2)) ;; Comment out region. (let ((beg (mark)) (cur-po (point)) (cur-po2 (point)) po-temp) (when (>= beg cur-po) (setq beg cur-po cur-po (mark))) (goto-char cur-po) (set-mark (point)) (goto-char beg) (insert (concat on-string "\n")) (goto-char (mark)) (insert (concat off-string "\n")) (when font-lock-mode (font-lock-fontify-block)))))) ;;; Jump between ontext and offtext. (defun gams-judge-on-off-text () "Judge whether curson is on ontext or offtext. ontext => return on and point, offtext => return off and point, Otherwise => return nil and nil. If ontext and offtext are commented out, return *on and *off respectively." (let (point-beg temp-text) (save-excursion (beginning-of-line) ;; (skip-chars-backward "^ \t\n") (when (looking-at (concat "^\\([" gams-comment-prefix "]?\\)[ \t]*[$]\\(on\\|off\\)text")) (setq point-beg (match-beginning 0)) (setq temp-text (downcase (gams*buffer-substring (match-beginning 2) (match-end 2)))) (if (string-match gams-comment-prefix (gams*buffer-substring (match-beginning 1) (match-end 1))) (setq temp-text (concat "*" temp-text))))) (cons temp-text point-beg))) (defun gams-search-on-off-text (cons) "" (let ((type (car cons)) (point (cdr cons)) (regexp (concat "^[" gams-comment-prefix "]?[ \t]*$\\(on\\|off\\)text")) flag match match-point) (save-excursion (cond ((equal type "on") (forward-char 1) (when (re-search-forward regexp nil t) (setq match-point (match-beginning 0)) (setq match (gams*buffer-substring (match-beginning 1) (match-end 1))))) ((equal type "*on") (forward-char 1) (when (re-search-forward regexp nil t) (setq match-point (match-beginning 0)) (setq match (concat "*" (gams*buffer-substring (match-beginning 1) (match-end 1)))))) ((equal type "off") (forward-char -1) (when (re-search-backward regexp nil t) (setq match-point (match-beginning 0)) (setq match (gams*buffer-substring (match-beginning 1) (match-end 1))))) ((equal type "*off") (forward-char -1) (when (re-search-backward regexp nil t) (setq match-point (match-beginning 0)) (setq match (concat "*" (gams*buffer-substring (match-beginning 1) (match-end 1)))))))) (cons match match-point))) (defun gams-jump-on-off-text () "Jump between ontext-offtext. If you execute this command on ontext (offtext), then you jump to the corresponding offtext (ontext)." (interactive) (let* ((temp (gams-judge-on-off-text)) (flag (car temp)) (point (cdr temp)) (cur-po (point)) (case-fold-search t) match-flag match-point) (when flag (setq match-flag (car (gams-search-on-off-text temp))) (setq match-point (cdr (gams-search-on-off-text temp)))) ;; ontext or offtext. (cond ((not flag) (message "This command is valid only if the cursor is on either ontext or offtext.")) ((and point match-point (not (equal flag match-flag))) (goto-char match-point) (if (equal flag "on") (message "The corresponding offtext is found!") (message "The corresponding ontext is found!"))) ((and point (or (not match-point) (equal flag match-flag))) (if (equal flag "on") (message "No corresponding offtext exists!") (message "No corresponding ontext exists!")))))) (defun gams-remove-on-off-text () "Remove the pair of ontext-offtext. If you evoke this command on ontext (offtext), then both ontext (offtext) and the corresponding offtext (ontext) are removed." (interactive) (gams-modify-on-off-text t)) (defun gams-comment-on-off-text () "Comment or uncomment the pair of ontext-offtext." (interactive) (gams-modify-on-off-text)) (defun gams-modify-on-off-text (&optional delete) "Modify the ontext-offtext pair. If DELETE is non-nil, delte the pair. Otherwise, comment out or uncomment out the pair." (save-excursion (let* ((temp (gams-judge-on-off-text)) (flag-beg (car temp)) (po-beg (cdr temp)) flag-com) (if (not flag-beg) (message (concat "This command is valid only if the cursor is " "on either ontext or offtext.")) (let* ((temp-end (gams-search-on-off-text (cons flag-beg po-beg))) (beg-end (car temp-end)) (po-end (cdr temp-end))) (if (not beg-end) (cond ((or (equal flag-beg "on") (equal flag-beg "*on")) (message "No corresponding offtext is found!")) ((or (equal flag-beg "off") (equal flag-beg "*off")) (message (format "No corresponding ontext is found!")))) ;; Found. (when (string-match "\\*" flag-beg) (setq flag-com t)) ;; If DELETE is non-nil. (if delete (progn (if flag-com (message (concat "Can't delete commented ontext-offtext! " "First uncoment them.")) (message "Delete the pair of ontext-offtext.") (goto-char po-end) (beginning-of-line) (sit-for 1) (delete-region (point) (progn (looking-at "^$\\(on\\|off\\)text") (match-end 0))) (goto-char po-beg) (beginning-of-line) (delete-region (point) (progn (looking-at "^$\\(on\\|off\\)text") (match-end 0))))) ;; Comment or uncomment. (if flag-com ;; Commented ontext offtext. (progn (message "Uncomment the pair of ontext-offtext.") (goto-char po-end) (beginning-of-line) (sit-for 1) (delete-region (point) (progn (looking-at (concat "^[" gams-comment-prefix "][ \t]*")) (match-end 0))) (goto-char po-beg) (beginning-of-line) (delete-region (point) (progn (looking-at (concat "^[" gams-comment-prefix "][ \t]*")) (match-end 0)))) ;; Uncommented ontext-offtext. (progn (message "Comment out a pair of ontext-offtext.") (goto-char po-end) (beginning-of-line) (sit-for 1) (insert (concat gams-comment-prefix " ")) (goto-char po-beg) (if (> po-beg po-end) (forward-char 2)) (beginning-of-line) (insert (concat gams-comment-prefix " "))))))))) (when font-lock-mode (font-lock-fontify-block)))) ;;; New function. (defun gams-goto-matched-paren () "Jump to the matched parenthesis. The similar function as F8 in GAMSIDE. This command is vaild only if the cursor is on the parenthesis." (interactive) (let ((right 0) (left 0) po) (save-excursion (cond ((equal "(" (char-to-string (following-char))) (setq left 1) (forward-char 1)) ((equal ")" (char-to-string (preceding-char))) (setq right 1) (forward-char -1))) (cond ((equal left 1) ;; Search ")" (progn (catch 'found (while t (if (re-search-forward "\\([)]\\)\\|\\([(]\\)" nil t) (progn (if (match-beginning 1) (setq right (+ 1 right)) (setq left (+ 1 left))) (when (equal right left) (setq po (point)) (throw 'found t))) (message "No matched parenthesis") (throw 'found t)))))) ((equal right 1) ;; Search "(" (catch 'found (while t (if (re-search-backward "\\([)]\\)\\|\\([(]\\)" nil t) (progn (if (match-beginning 1) (setq right (+ 1 right)) (setq left (+ 1 left))) (when (equal right left) (setq po (point)) (throw 'found t))) (message "No matched parenthesis") (throw 'found t))))) (t (message "This command is valid only if the cursor is on `(' or `)'.")))) (when po (goto-char po) (message "Jump to the matched parenthesis") ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Insert parens, quotations ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; From yatex.el (defun gams-insert-parens (arg) "Insert a parenthesis pair if `gams-close-paren-always' is non-nil. If you attach the prefix argument, just insert `('." (interactive "P") (if gams-close-paren-always (if arg (insert "(") (insert "()") (backward-char 1)) (insert "("))) (defun gams-close-quotation-p (&optional double) "If the single (or double) quotation should be closed, return t. Otherwise nil. If DOUBLE is non-nil, check double quoatati