;; @(#) specman-mode.el -- Mode for editing specman files
;; @(#) $Id: specman-mode.el,v 1.21 2002/04/04 00:53:43 mac Exp mac $
;; @(#) $Keywords: tools $
;; $KnownCompatibility: 19.28 $

;; This file is not part of Emacs


;; Copyright (C) 2000 Michael McNamara
;; Authors:      Michael McNamara <mac@verisity.com>
;;               Yaron Peri <yperi@verisity.com>
;; Maintainer:   Michael McNamara <mac@verisity.com>
;; Created:      May 5 2000


;; LCD Archive Entry:
;; specman-mode|Michael McNamara|mac@verisity.com|
;; Specman Major mode. auto indents, colorizes, code in the 'e language|
;; 05-May-2000|$Revision: 1.21 $|~/misc/specman-mode.el.Z|

;; COPYRIGHT NOTICE
;;
;; 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 of the License, 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.
;;
;; You should have received a copy of the GNU General Public License along
;; with GNU Emacs.  If you did not, write to the Free Software Foundation,
;; Inc., 675 Mass Ave., Cambridge, MA 02139, USA.

;;
;;  SPECMAN MODE - A Major mode for writing in 'e'
;;

;; ....................................................... &t-install ...
;; Put this file on your Emacs-Lisp load path, add following into your
;; ~/.emacs startup file
;;
;;   (require 'specman-mode)
;;
;; Or add the following code to your .emacs:
;;  
;; (autoload 'specman-mode "specman-mode" "Specman code editing mode" t) 
;;
;; (setq auto-mode-alist 
;;	  (append (list 
;;		   (cons "\\.e\\'" 'specman-mode)
;;		   (cons "\\.e3\\'" 'specman-mode)
;;		   (cons "\\.load\\'" 'specman-mode)
;;		   (cons "\\.ecom\\'" 'specman-mode)
;;		   (cons "\\.etst\\'" 'specman-mode))
;;		  auto-mode-alist))                     
;;
;;; Commetary:
;;
;;  specman-mode is a major mode for editing code written in the 'e' language
;;

(defconst specman-mode-version "$$Revision: 1.21 $$"
  "Version of this Specman mode.")

(defun specman-version ()
  "Inform caller of the version of this file"
  (interactive)
  (message (concat "Using specman-mode version " 
		   (substring specman-mode-version 12 -3 )) )
  )

(autoload 'specman-mode "specman-mode" "Specman code editing mode" t) 

(setq auto-mode-alist 
	  (append (list 
		   (cons "\\.e\\'" 'specman-mode)
		   (cons "\\.e3\\'" 'specman-mode)
		   (cons "\\.load\\'" 'specman-mode)
		   (cons "\\.ecom\\'" 'specman-mode)
		   (cons "\\.etst\\'" 'specman-mode))
		  auto-mode-alist))                     
(add-hook 'specman-mode-hook
	  (lambda () (turn-on-font-lock)
	    (setq indent-tabs-mode nil)
	    (setq write-file-hooks nil)
	    ))


(defmacro specman-safe (&rest body)
  "Safely execute BODY, return nil if an error occurred."
  `(condition-case nil
       (progn ,@body)
     (error nil)))

(if (fboundp 'eval-when-compile)
    (eval-when-compile
      (condition-case nil
          (require 'cl)	; FSF emacs's imenu needs cl, but doesn't (require 'cl)
        (error nil))
      (condition-case nil
          (require 'imenu)
        (error nil))
      (condition-case nil
	  (unless (fboundp 'imenu-add-to-menubar)
	    (defun imenu-add-to-menubar (a) ))
	(error nil))
      (condition-case nil
	  (require 'reporter)
        (error nil))
      (condition-case nil
	  (if (boundp 'current-menubar)
	      nil ;; great
	    (defmacro set-buffer-menubar (&rest args) nil)
	    (defmacro add-submenu (&rest args) nil))
	(error nil))
      (condition-case nil
	  (require 'func-menu)
	(error nil))
      (condition-case nil
	  (unless (fboundp 'char=)
	    (defun char= (a b)
	      (= a b)))
	(error nil))
      (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
	  nil ;; We've got what we needed
	;; We have the old custom-library, hack around it!
	(defmacro defgroup (&rest args)  nil)
	(defmacro customize (&rest args)
	  (message "Sorry, Customize is not available with this version of emacs"))
	(defmacro defcustom (var value doc &rest args)
	  (` (defvar (, var) (, value) (, doc))))
	)
      (if (fboundp 'defface)
	  nil ; great!
	(defmacro defface (var value doc &rest args)
	  (` (make-face (, var))))
	)
      (if (and (featurep 'custom) (fboundp 'customize-group))
	  nil ;; We've got what we needed
	;; We have an intermediate custom-library, hack around it!
	(defmacro customize-group (var &rest args)
	  (`(customize (, var) )))
	)
      (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
	  nil ;; We've got what we needed
	;; We have the old custom-library, hack around it!
	(defmacro defgroup (&rest args)  nil)
	(defmacro customize (&rest args)
	  (message "Sorry, Customize is not available with this version of emacs"))
	(defmacro defcustom (var value doc &rest args)
	  (` (defvar (, var) (, value) (, doc))))
	)
      
      (if (and (featurep 'custom) (fboundp 'customize-group))
	  nil ;; We've got what we needed
	;; We have an intermediate custom-library, hack around it!
	(defmacro customize-group (var &rest args)
	  (`(customize (, var) )))
	)
      (condition-case nil
          (require 'easymenu)
        (error nil))))
;; If you install xemacs-devel, you will get a 10-20% speedup.
;; if not, you get this:
(unless (fboundp 'regexp-opt)
  (defun regexp-opt (strings &optional paren)
    (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
      (concat open (mapconcat 'regexp-quote strings "\\|") close))))
(unless (fboundp 'char=)
  (defun char= (a b)
    (= a b)))

(if (not (boundp 'fume-function-name-regexp-alist))
    (progn 
      (defvar fume-function-name-regexp-alist nil "")
      (defvar fume-find-function-name-method-alist "")
      )
  (setq fume-function-name-regexp-alist
	(append
	 '((specman-mode . fume-function-name-regexp-specman))
	 fume-function-name-regexp-alist
	 )
	fume-find-function-name-method-alist
	(append
	 '((specman-mode . fume-find-next-specman-method-name))
	 fume-find-function-name-method-alist
	 )
	)
  )

(if (not (boundp 'imenu-generic-expression))
    (defvar imenu-generic-expression))



;; =================================================
;; SPECMAN MISC VARS
;; =================================================
;;; - Customizable variables

(if (< max-specpdl-size 3000) 
    (setq max-specpdl-size 3000))

(defgroup specman-mode nil
  "Facilitates easy editing of Specman source text"
  :group 'languages)

(defcustom specman-basic-offset 3
  "*Indentation of Specman statements with respect to containing block."
  :group 'specman
  :type 'integer
  )

(defcustom specman-continued-line-offset 2
  "*Indentation of continued Specman statements with respect to first line of statement."
  :group 'specman
  :type 'integer
  )

(defcustom specman-line-up-bracket nil
  "*ON (or non nil) means to indent lines continued in a [] type list relative
to the position of the '['. Otherwise line them based on the start of the line, as usual."
  :group 'specman
  :type 'boolean
  )

(defcustom specman-line-up-paren nil
  "*ON (or non nil) means to indent lines continued in a () type list relative
to the position of the '('.  Otherwised line them based on the start of the line, as usual."
  :group 'specman
  :type 'boolean
  )

(defcustom specman-semi-is-electric t
  "*ON (or non nil) means semicolon has magical properties"
  :group 'specman
  :type 'boolean
  )

(defcustom specman-curly-opener-is-electric t
  "*ON (or non nil) means to reindent the current line upon entering '{'."
  :group 'specman
  :type 'boolean
  )

(defcustom specman-curly-closer-is-electric t
  "*ON (or non nil) means to reindent the current line upon entering '}'."
  :group 'specman
  :type 'boolean
  )

(defcustom specman-auto-newline t
  "*ON (or non nil) means to automatically newline after inserting a semicolon."
  :group 'specman
  :type 'boolean
  )

(defconst specman-tab-width 4
  "*Tab stop width")

(defvar specman-mode-abbrev-table nil
  "Abbrev table in use in Specman-mode buffers.")

(define-abbrev-table 'specman-mode-abbrev-table ())

(defconst specman-ex-comment-regexp "\\(^[ \t]*'>\\)\\|\\(^[ \t]*<'\\)" 
  "Regular Expression that matches ex-comment tokens")
(defconst specman-function-name-regexp
  (concat "^\\s-*\\(\\w+\\)\\s-*(.*)\\s-*\\(:\\s-*[^{]+\\)?\\s-*\\(@\\s-*.*\\)?"
	  "\\s-+is\\s-*\\(also\\|inline\\|first\\|only\\)?\\s-*{" )
  "Regexp that identifies methods (arg 1)")

(defconst specman-variable-definition-regexp
  "\\(\\w+\\)\\s-*:\\s-*\\(\\w+\\)"
  "Regexp that identifies variable definitions (arg 1)")


(defsubst specman-re-search-forward (REGEXP BOUND NOERROR)
  "Like re-search-forward, but skips over matches in comments or strings"
  (store-match-data '(nil nil))
  (while (and
	  (re-search-forward REGEXP BOUND NOERROR)
	  (and (specman-skip-forward-comment-or-string)
	       (progn
		 (store-match-data '(nil nil))
		 (if BOUND
		     (< (point) BOUND)
		   t)
		 )
	       )
	  )
    )
  (match-end 0))

(defsubst specman-re-search-backward (REGEXP BOUND NOERROR)
  "Like re-search-backward, but skips over matches in comments or strings"
  (store-match-data '(nil nil))
  (while (and
	  (re-search-backward REGEXP BOUND NOERROR)
	  (and (specman-skip-backward-comment-or-string)
	       (progn
		 (store-match-data '(nil nil))
		 (if BOUND
		     (> (point) BOUND)
		   t)
		 )
	       )
	  )
    )
  (match-end 0))

(defsubst specman-beg-of-line-pos ()
  (save-excursion
    (beginning-of-line)
    (point)))

(defsubst specman-within-comment-p ()
  (save-excursion
    (or 
     (nth 4 (parse-partial-sexp (point-min) (point)))      ;; true if we are in a -- region, or a // EOL region
     (not (re-search-backward specman-ex-comment-regexp nil 't)) ; true if looking back, we see no e code at all
     (match-beginning 1) ;; looking back, we see a '> before we see a <' 
     )))

(defsubst specman-re-search-forward-quick (regexp bound noerror)
  "Like specman-re-search-forward, but trashes match data and
is faster for regexps that don't match much.
This may at some point use text properties to ignore comments,
so there may be a large up front penalty for the first search."
  (let (pt)
    (while (and (not pt)
		(re-search-forward regexp bound noerror))
      (if (not (specman-within-comment-p))
	  (setq pt (match-end 0))))
    pt))

(defsubst specman-re-search-backward-quick (regexp bound noerror)
  "Like specman-re-search-forward, but trashes match data and
is faster for regexps that don't match much.
This may at some point use text properties to ignore comments,
so there may be a large up front penalty for the first search."
  (let (pt)
    (while (and (not pt)
		(re-search-backward regexp bound noerror))
      (if (not (specman-within-comment-p))
	  (setq pt (match-end 0))))
    pt))

(defsubst specman-empty-line-p ()
  (looking-at "^[ \t]*$"))

(defun specman-within-string-p ()
  (save-excursion
    (nth 3 (parse-partial-sexp (point-min) (point)))))

(defsubst specman-line-within-string-p ()
  (save-excursion
    (beginning-of-line)
    (nth 3 (parse-partial-sexp (point-min) (point)))))

(defsubst specman-line-within-comment-p ()
  (save-excursion
    (beginning-of-line)
    (specman-within-comment-p)))

(defsubst specman-middle-line-p ()
  (not (specman-first-line-p)))

;; =================================================
;; SPECMAN SYNTAX TABLE
;; =================================================
(defconst specman-emacs-features
  (let ((major (and (boundp 'emacs-major-version)
		    emacs-major-version))
	(minor (and (boundp 'emacs-minor-version)
		    emacs-minor-version))
	flavor comments )
    ;; figure out version numbers if not already discovered
    (and (or (not major) (not minor))
	 (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
	 (setq major (string-to-int (substring emacs-version
					       (match-beginning 1)
					       (match-end 1)))
	       minor (string-to-int (substring emacs-version
					       (match-beginning 2)
					       (match-end 2)))))
    (if (not (and major minor))
	(error "Cannot figure out the major and minor version numbers."))
    ;; calculate the major version
    (cond
     ((= major 4)  (setq major 'v18))	;Epoch 4
     ((= major 18) (setq major 'v18))	;Emacs 18
     ((= major 19) (setq major 'v19	;Emacs 19
			 flavor (if (or (string-match "Lucid" emacs-version)
					(string-match "XEmacs" emacs-version))
				    'XEmacs 'FSF)))
     ((> major 19) (setq major 'v20
			 flavor (if (or (string-match "Lucid" emacs-version)
					(string-match "XEmacs" emacs-version))
				    'XEmacs 'FSF)))
     ;; I don't know
     (t (error "Cannot recognize major version number: %s" major)))
    ;; XEmacs 19 uses 8-bit modify-syntax-entry flags, as do all
    ;; patched Emacs 19, Emacs 18, Epoch 4's.  Only Emacs 19 uses a
    ;; 1-bit flag.  Let's be as smart as we can about figuring this
    ;; out.
    (if (or (eq major 'v20) (eq major 'v19))
	(let ((table (copy-syntax-table)))
	  (modify-syntax-entry ?a ". 12345678" table)
	  (cond
	   ;; XEmacs pre 20 and Emacs pre 19.30 use vectors for syntax tables.
	   ((vectorp table)
	    (if (= (logand (lsh (aref table ?a) -16) 255) 255)
		(setq comments '8-bit)
	      (setq comments '1-bit)))
	   ;; XEmacs 20 is known to be 8-bit
	   ((eq flavor 'XEmacs) (setq comments '8-bit))
	   ;; Emacs 19.30 and beyond are known to be 1-bit
	   ((eq flavor 'FSF) (setq comments '1-bit))
	   ;; Don't know what this is
	   (t (error "Couldn't figure out syntax table format."))
	   ))
      ;; Emacs 18 has no support for dual comments
      (setq comments 'no-dual-comments))
    ;; lets do some minimal sanity checking.
    (if (or
	 ;; Lemacs before 19.6 had bugs
	 (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6))
	 ;; Emacs 19 before 19.21 has known bugs
	 (and (eq major 'v19) (eq flavor 'FSF) (< minor 21))
	 )
	(with-output-to-temp-buffer "*specman-mode warnings*"
	  (print (format
		  "The version of Emacs that you are running, %s,
has known bugs in its syntax parsing routines which will affect the
performance of specman-mode. You should strongly consider upgrading to the
latest available version.  Specman-mode may continue to work, after a
fashion, but strange indentation errors could be encountered."
		  emacs-version))))
    ;; Emacs 18, with no patch is not too good
    (if (and (eq major 'v18) (eq comments 'no-dual-comments))
	(with-output-to-temp-buffer "*specman-mode warnings*"
	  (print (format
		  "The version of Emacs 18 you are running, %s,
has known deficiencies in its ability to handle the dual specman
comments, [e.g. the // and -- comments]. You really should strongly
consider upgrading to one of the latest Emacs 19\'s.  In Emacs 18, you
may also experience performance degradations.  Emacs 19 has some new
built-in routines which will speed things up for you.  Because of
these inherent problems, specman-mode is not supported on emacs-18."
		  emacs-version))))
    ;; Emacs 18 with the syntax patches are no longer supported
    (if (and (eq major 'v18) (not (eq comments 'no-dual-comments)))
	(with-output-to-temp-buffer "*specman-mode warnings*"
	  (print (format
  "You are running a syntax patched Emacs 18 variant.  While this should
work for you, you may want to consider upgrading to Emacs 19.
The syntax patches are no longer supported either for specman-mode."))))
    (list major comments ))
  "A list of features extant in the Emacs you are using.
There are many flavors of Emacs out there, each with different
features supporting those needed by specman-mode.  Here's the current
supported list, along with the values for this variable:

 Vanilla Emacs 18/Epoch 4:   (v18 no-dual-comments flock-syntax-before-1930)
 Emacs 18/Epoch 4 (patch2):  (v18 8-bit flock-syntax-after-1930)
 XEmacs (formerly Lucid) 19: (v19 8-bit flock-syntax-after-1930)
 XEmacs >= 20:               (v20 8-bit flock-syntax-after-1930)
 Emacs 19.1-19.30:           (v19 8-bit flock-syntax-before-1930)
 Emacs 19.31-19.xx:          (v19 8-bit flock-syntax-after-1930)
 Emacs >=20:                 (v20 1-bit flock-syntax-after-1930)."
  )

(defun specman-populate-syntax-table (table)
  (modify-syntax-entry ?_  "w"        table)
  (modify-syntax-entry ?{  "(}"       table)
  (modify-syntax-entry ?}  "){"       table)
  (modify-syntax-entry ?\(  "()"       table)
  (modify-syntax-entry ?\)  ")("       table)
  (modify-syntax-entry ?\[  "(]"       table)
  (modify-syntax-entry ?\]  ")["       table)
  (modify-syntax-entry ?\% "."        table)
  (modify-syntax-entry ?\' "."        table)
  (modify-syntax-entry ?\< "."        table)
  (modify-syntax-entry ?\> "."        table)
  (modify-syntax-entry ?\\ "\\"       table)
  table
  )

(defun specman-populate-comment-syntax-table (table)
  (modify-syntax-entry ?_  "w"        table)
  (cond
   ((memq '8-bit specman-emacs-features)
    ;; XEmacs (formerly Lucid) has the best implementation
    (modify-syntax-entry ?/  ". 56" table)
    (modify-syntax-entry ?\n "> 7" table)
    (modify-syntax-entry ?\f "> 7" table)
    )
   ((memq '1-bit specman-emacs-features)
    ;; Emacs 19 does things differently, but we can work with it
    (modify-syntax-entry ?/  ". 12" table)
    (modify-syntax-entry ?\n "> 3"    table)
    (modify-syntax-entry ?\f "> 3"    table)
    )
   )
  table
  )

(defun specman-setup-dual-comments (table)
  ;; Set up TABLE to handle block and line style comments
  (cond
   ((memq '8-bit specman-emacs-features)
    ;; XEmacs (formerly Lucid) has the best implementation
    (modify-syntax-entry ?/  ". 12" table)
    (modify-syntax-entry ?-  ". 56" table)
    (modify-syntax-entry ?\n "> 37" table)
    (modify-syntax-entry ?\f "> 37" table)
    ;(with-output-to-temp-buffer "FOO"(describe-syntax-table table nil))
    )
   ((memq '1-bit specman-emacs-features)
    ;; Emacs 19 does things differently, but we can work with it
    (modify-syntax-entry ?/  ". 12" table)
    (modify-syntax-entry ?-  ". 12b"   table)
    (modify-syntax-entry ?\n "> 34"    table)
    (modify-syntax-entry ?\f "> 34"    table)
    )
   ))


;; =================================================
;; SPECMAN IMENU FEATURE
;; =================================================

(defconst WS0n "[ \n\t]*")
(defconst WS1n "[ \n\t]+")

(defvar specman-imenu-generic-expression
  (`
   (
    ("*Methods*"   
     (, 
      (concat 
       "^[ \t]*\\([A-Za-z0-9_]+\\)"
       WS0n
       "([^()]*\\(([^()]*)[^()]*\\)*)"
       WS0n
       "\\(: *[^{]+\\)?"
       WS0n
       "\\(@ *[^ ]+\\)?"
       WS1n
       "is"
       "\\(" WS1n "\\(also\\|only\\|first\\)\\)?"
       WS0n
       "{"
       )) 1)
    ("*Events*" 
     (,
      (concat 
       "^[ \t]*event"
       WS1n
       "\\([A-Za-z0-9_]+\\)"
       WS1n
       "is\\>"
       )) 1)
    ("*Vars*" 
     (,
      (concat				; match '^ WS word WS : WS word WS ;'
       "^"
       WS0n				; match WS
       "var"				; 'var'
       WS1n				; match WS
       "\\(\\w+\\)"			; match another word
       WS0n				; match WS
       ":"				; a colon
       )) 1)
    ("*Enums*" 
     (, 
      (concat				; match '^ WS word WS : WS word WS ;'
       "^"
       WS0n				; match WS
       "type"				; 'type'
       WS1n				; match WS,
       "\\(\\w+\\)"			; match a word
       WS0n				; match WS
       ":"				; a colon
       WS0n				; match WS
       "\\["				; and a bracket
       )) 1)
    ("*Fields*" 
     (, 
      (concat				; match '^ WS word WS : [list of]? 
       "^"
       WS0n				; match WS
       "\\(\\w+\\)"			; match a word
       WS1n				; match WS
       ":"				; a colon
       WS1n				; match WS
       "\\(list" WS1n "of" WS1n "\\)?"	; optionally a 'list of '
       "\\(\\(\\[[^]]+\\]\\)"
       "\\|"
       "\\(\\w+\\)\\)"			; or single type name
       WS0n				; match WS
       "\\(is" WS1n "instance" WS1n "\\)?" ; optionally a 'is instance'
       ";"                          ; and a semicolon
       )) 1)
    ("*Units*" 
     (, 
      (concat 
       "^"
       WS0n				; match WS
       "unit"				; match 'unit'
       WS1n				; match WS
       "\\(\\w+\\)"			; match a word
       WS0n				; match WS
       "\\(like[^{]+\\)?"		; optionally by 'like through {'
       "{" 				; match a '{'
       )) 1)
    ("*Structs*" 
     (,
      (concat 
       "^"
       WS0n				; match WS
       "struct"			; match 'struct'
       WS1n				; match WS
       "\\(\\w+\\)\\>"			; match a word
       WS0n				; match WS
       "\\(like[^{]+\\)?"		; optionally by 'like through {'
       "{" 				; match a '{'
       )) 1)
    ))
  "Imenu expression for Specman-mode.  See `imenu-generic-expression'.")

;; =================================================
;; SPECMAN FUME FUNCTIONALITY
;; =================================================

;;; Specman
;;;
;;; Matthew Lovell <lovell@fc.hp.com>
;;;   Up to one level of parentheses is allowed in the parameter
;;;   list to a method.  The regex pattern for that portion if
;;;   from J. Friedl's "Mastering Regular Expressions"
;;;
(defvar fume-function-name-regexp-specman
  "^[ \t]*\\([A-Za-z0-9_]+\\)[ \t\n]*([^()]*\\(([^()]*)[^()]*\\)*)[ \t\n]*\\(: *[^{]+\\)?[ \t\n]*\\(@ *[^ ]+\\)? *is\\( also\\| only\\| first\\| inline\\)?[ \t\n]*{"
  "Expression to get a Specman method")


;;; Specialised routine to find the next Specman method
(defun fume-find-next-specman-method-name (buffer)
  "Searches for the next Specman method in BUFFER."
  (if (re-search-forward fume-function-name-regexp-specman nil t)
      (let ((beg (match-beginning 1))
            (end (match-end 1)))
        (cons (buffer-substring beg end) beg))))

(defun specman-current-method-name (lim)
  "Searches for the current Specman method."
  (if (re-search-backward specman-function-name-regexp lim t)
      (let ((beg (match-beginning 1))
            (end (match-end 1)))
        (buffer-substring beg end))))
;; =================================================
;; SPECMAN UTILITY
;; =================================================

;; Macros
(defmacro inc (num &optional val) 
  "increment the value of num"
  (setq num (+ num (or val 1))))

(defmacro for (var from init to final do &rest body)
  "Execute a simple \"for\" loop, e.g.,
    (for i from 1 to 10 do (print i))."
  (list 'let (list (list var init))
        (cons 'while 
		(cons (list '<= var final)
			(append body (list (list 'setq var (list '+ '1 var))))))))

(defmacro specman-point (position)
  "Return the value of point at certain commonly referenced POSITIONs.
POSITION can be one of the following symbols:

bol  -- beginning of line
eol  -- end of line
bod  -- beginning of defun
boi  -- back to indentation
eoi  -- last whitespace on line
ionl -- indentation of next line
iopl -- indentation of previous line
bonl -- beginning of next line
bopl -- beginning of previous line

This function does not modify point or mark."
  (or (and (eq 'quote (car-safe position))
	   (null (cdr (cdr position))))
      (error "Bad buffer position requested: %s" position))
  (setq position (nth 1 position))
  `(let ((here (point)))
     ,@(cond
	((eq position 'bol)  '((beginning-of-line)))
	((eq position 'eol)  '((end-of-line)))
	((eq position 'bod)  '((save-match-data
				 (specman-beg-of-defun))))
	((eq position 'boi)  '((back-to-indentation)))
	((eq position 'eoi)  '((end-of-line)(skip-chars-backward " \t")))
	((eq position 'bonl) '((forward-line 1)))
	((eq position 'bopl) '((forward-line -1)))
	((eq position 'iopl)
	 '((forward-line -1)
	   (back-to-indentation)))
	((eq position 'ionl)
	 '((forward-line 1)
	   (back-to-indentation)))
	(t (error "Unknown buffer position requested: %s" position))
	)
     (prog1
	 (point)
       (goto-char here))
     ;; workaround for an Emacs18 bug -- blech! Well, at least it
     ;; doesn't hurt for v19
     ,@nil
     ))

(defun specman-first-line-p ()
  (eq (specman-beg-of-line-pos) 1))

(defun specman-in-paren-p ()	
  "Return true if in a parenthetical expression"
  (save-excursion
    (specman-up-list)			; this actually moves us
    ))

(defun specman-previous-line ()
  (when (specman-middle-line-p) 
	(beginning-of-line)
	(re-search-backward "^.*[^ \t\r\n]+.*$" (point-min) t)))


(defun specman-skip-forward-comment-or-string ()
 "Return true if in a string or comment"
 (let ((state
	(save-excursion
	  (parse-partial-sexp (point-min) (point)))))
   (cond
    ((nth 3 state)			;Inside string
     (search-forward "\"" nil 'move )
     t)
    ((nth 4 state)			;Inside -- or // comment
     (forward-line 1))
    (t
     nil)
    )
   )
 )

(defun specman-skip-backward-comment-or-string ()
 "Move to the begining and return true if in a string or comment"
 (if ;; we are in an 'ex-comment region' return nil
     (save-excursion
       (or (not (re-search-backward specman-ex-comment-regexp nil 't)) ; true if looking back, we see no e code at all
	   (match-beginning 1)));; looking back, we see a '> before we see a <' 
     nil
   (let ((state
	  (save-excursion
	    (parse-partial-sexp (point-min) (point)))))
     (cond
      ((nth 3 state)			;Inside string
       (search-backward "\"" 0 'move)
       t)
      ((nth 7 state)			;Inside -- comment
       (search-backward "--")
       t)
      ((nth 4 state)			;Inside // comment
       (search-backward "//")
       t)
      (t
       nil)
      ))))
(defun specman-skip-backward-comment ()
 "Move to the begining and return true if in a comment"
 (let ((state
	(save-excursion
	  (parse-partial-sexp (point-min) (point)))))
   (cond
    ((or
      (not (re-search-backward specman-ex-comment-regexp nil 't)) ; true if looking back, we see no e code at all
      (match-beginning 1) ;; looking back, we see a '> before we see a <' 
      )
     nil)
    ((nth 7 state)			;Inside -- comment
     (search-backward "--")
     t)
    ((nth 4 state)			;Inside // comment
     (search-backward "//")
     t)
    (t
     nil)
    )))


(defun specman-return-enclosing-comment-prefix ()
 "Return comment prefix for comment point is in, or nil"
 (save-excursion
   (let ((state (parse-partial-sexp (point-min) (point))))
     (cond
      ((or 
	(save-excursion 
	  (not (re-search-backward specman-ex-comment-regexp nil 't)) ; true if looking back, we see no e code at all
	  (match-beginning 1)) ;; looking back, we see a '> before we see a <' 
	)
       nil)
      ((nth 7 state)			;Inside -- comment
       (re-search-backward "--[ \t]*")
       (concat (format "%*s" (current-column) " ") (match-string 0)))
      ((nth 4 state)			;Inside // comment
      (re-search-backward "//[ \t]*")
       (concat (format "%*s" (current-column) " ") (match-string 0)))
      (t
       nil)
      )
     )
   )
)

(defun specman-in-line-comment-p ()
  "Return true if in a // or -- comment"
  (let ((state
	 (save-excursion
	   (parse-partial-sexp (point-min) (point)))))
    (nth 4 state)))

(defun specman-in-comment-or-string-p ()
  "Return true if in a string or comment."
  (let ((state
	 (save-excursion
	   (parse-partial-sexp (point-min) (point)))))
    (or (nth 3 state) (nth 4 state)))) ; Inside string or comment)

(defun goto-char-if (pos)
  (if (> pos 0) 
      (progn
	(goto-char pos)
	t)
    nil))


(defun specman-goto-first-char ()
  (interactive)
  (beginning-of-line)
  (skip-chars-forward "[ \t]"))
  
(defun start-char-pos ()
  (save-excursion
    (specman-goto-first-char)
    (current-column)))

(defun specman-delete-char ()
  (interactive)
  (delete-char 1))

;; INDENT
(defun specman-set-indent (col)
  (let ((here (point)))
    (save-excursion
      (beginning-of-line)
      (skip-chars-forward " \t")
      (if (/= (point) here)
	  (progn
	    (just-one-space)
	    (indent-to col))))))

;; TAB\BACKSAPECE
(defun specman-insert-tab ()
  (interactive)
  ;; if we are inside a string, put plain tab
  (if (specman-within-string-p)
      (insert "\t")
    (progn
      (insert " ")
      (while (not (eq (% (current-column) specman-tab-width) 0))
	(insert " ")))))

(defun specman-remove-tab ()
  (interactive)
  ;; if we are inside a string, delete one char
  (let
    ((start-with-space (char= (char-before) ?\  )))
    (delete-backward-char 1)
    (if (and (not (specman-within-string-p)) start-with-space)
	(while 
	    (and (not (eq (% (current-column) 
			     specman-tab-width) 0))
		 (char= (char-before) ?\  ))
	  (delete-backward-char 1)))))

;; =================================================
;; SPECMAN MODE MAP
;; =================================================
(defconst specman-mode-map 
  (let ((map (make-sparse-keymap)))
    (define-key map [(tab)]       'specman-softest-new-line)
    (define-key map "\C-c\C-t"    'specman-insert-tab)
    (define-key map "\C-c\C-a"    'specman-redo-endcomments)
    (define-key map "\C-c\C-b"    'specman-submit-bug-report)
    (define-key map [(backspace)] 'specman-remove-tab)
    (define-key map [(delete)]    'specman-delete-char)
    (define-key map "\r"          'specman-new-line)
    (define-key map ";"           'specman-electric-semi)
    (define-key map "\C-c\C-u"    'specman-soft-new-line)
    (define-key map "\C-c\C-y"    'specman-softest-new-line)
    (define-key map "\C-c\C-p"    'specman-describe-point)
    (define-key map "\C-c\C-x"    'specman-keep-new-line)
    (define-key map "\C-c\C-h"    'specman-goto-first-char)
    (define-key map "\C-c\C-l"    'eval-from-minibuffer)
    (define-key map "\C-c@"       'specman-toggle-hide-comments)
    (define-key map "{"           'specman-electric-curly-opener)
    (define-key map "}"           'specman-electric-curly-closer)
    map)
  "Keymap used in Specman mode."
  )    


(defconst hide-ifdef-mode-prefix-key [(control c) @]
  "Prefix key for all Hide-Ifdef mode commands.")


;; =================================================
;; SPECMAN FONTLOCK SUPPORT
;; =================================================
(defvar specman-mode-syntax-table nil
  "Syntax table used in specman-mode buffers.")

(defvar specman-mode-comment-syntax-table nil
  "Syntax table used for font-lock in specman-mode buffers.")

(defconst specman-font-lock-keywords nil
  "Default highlighting for Specman mode.")

(defconst specman-font-lock-keywords-1 nil
  "Subdued level highlighting for Specman mode.")

(defconst specman-font-lock-keywords-2 nil
  "Medium level highlighting for Specman mode.
See also `specman-font-lock-extra-types'.")

(defconst specman-font-lock-keywords-3 nil
  "Gaudy level highlighting for Specman mode.
See also `specman-font-lock-extra-types'.")

(let 
    (
     (specman-types-keywords
	(eval-when-compile
	  (concat "\\<\\("
		  (regexp-opt
		   '( "bit" "bits" "bool" "byte" "bytes" "file" "string" "uint"
          "it" "index" "result"
          "TRUE" "FALSE" "UNDEF" "NULL" ))
		  "\\)\\>")))
     
     (specman-function-keywords
      (eval-when-compile
	(concat "\\<\\("
	(regexp-opt
	 '(
	   "abs" "add" "add0" "all_indices" "and_all" "append" "appendf" "apply"
	   "average" "bin" "bitwise_op" "check" "check_test" "clear" "count"
	   "crc_32" "crc_32_flip" "crc_8" "date_time" "dec" "deep_compare"
	   "deep_compare_physical" "deep_copy" "delete" "div_round_up"
	   "dut_error" "even" "exists" "extract" "fast_delete" "field" "finalize"
	   "finalize_test" "first" "first_index" "get_config" "get_indicies"
	   "get_keep" "get_symbol" "has" "hex" "ilog10" "ilog2" "init" "insert"
	   "ipow" "is_a_permutation" "is_empty" "isqrt" "key" "key_exists"
	   "key_index" "last" "last_index" "max" "max_index" "max_value" "min"
	   "min_index" "min_value" "odd" "or_all" "out" "outf" "output_from"
	   "output_from_check" "pack" "pop" "pop0" "post_generate" "pre_generate"
	   "product" "push" "push0" "quit" "quote" "read_config" "resize"
	   "reverse" "run" "run_test" "set_config" "set_keep" "setup" "size"
	   "sort" "sort_by_field" "spawn" "spawn_check" "specman" "split"
	   "start_test" "stop_run" "str_chop" "str_empty" "str_exactly"
	   "str_expand_dots" "str_insensitive" "str_join" "str_len" "str_lower"
	   "str_match" "str_pad" "str_replace" "str_split" "str_split_all"
	   "str_sub" "str_upper" "sum" "system" "top" "top0" "to_string" "unique"
	   "unpack" "write_config"

	   ))		  
  "\\)\\>")))

     (specman-keywords
      (eval-when-compile
	(concat "\\<\\(" 
	(regexp-opt
	 '(
	   "a" "add" "address_all" "also" "always" "and" "as" "as_a" "basic"
	   "before" "break" "by" "C" "call_case" "case" "change" "check" "choose"
	   "clock" "code" "compute" "computed" "continue" "cover" "cross" "cycle"
	   "cycles" "default" "define" "delay" "delayed" "detach" "do" "DOECHO"
	   "down" "each" "ECHO" "edges" "else" "emit" "empty" "end" "error"
	   "event" "events" "exec" "exit" "expect" "extend" "fail" "fall" "fill"
	   "finish" "first" "for" "force" "forever" "from" "gen" "high" "idle"
	   "if" "illegal" "import" "in" "initial" "initialize" "int" "intersects"
	   "is" "item" "keep" "keeping" "key" "kind" "length" "like" "line"
	   "list" "log" "low" "matches" "matching" "max" "me" "min" "mode" "nand"
	   "negedge" "network" "new" "next" "no" "non" "nor" "normal" "not"
	   "nxor" "of" "on" "only" "or" "others" "out" "outf" "packing" "pass"
	   "por" "posedge" "print" "range" "ranges" "read" "release" "repeat"
	   "report" "return" "reverse" "rise" "routine" "sample" "script"
	   "select" "sequence" "soft" "start" "step" "struct" "sync" "task"
	   "terminal" "testgroup" "text" "that" "then" "time" "to"
	   "traceable" "transition" "true" "try" "type" "undefined" "unit"
	   "until" "untraceable" "using" "value" "var" "verilog" "vhdl" "wait"
	   "when" "while" "with" "within" "write" "xor"
	   
	   ))
	"\\)\\>"))))
  (setq specman-font-lock-keywords
	(list
	 ;; Fontify comments
	 (cons "\\(//.*$\\)\\|\\(--.*$\\)" '(0 font-lock-comment-face))
	 ; (cons "//.*$" '(0 font-lock-comment-face))
	 ;; Fontify all types
	 (cons specman-types-keywords '(0 font-lock-type-face))
	 ;; Fontify macros
	 (cons "#\\(ifn?def\\|else\\)" '(0 font-lock-type-face))
	 ;; Fontify all builtin keywords
	 (cons specman-keywords '(0 font-lock-keyword-face keep))
	 ;; Fontiy keywords that include spaces (!)
	 (cons 
	  ( concat
      "\\<"
      "\\(all[ \t]+of\\)\\|"
      "\\(check[ \t]+that\\)\\|"
      "\\(each[ \t]+file\\)\\|"
      "\\(each[ \t]+line\\)\\|"
      "\\(first[ \t]+of\\)\\|"
      "\\(in[ \t]+range\\)\\|"
      "\\(is[ \t]+a\\)\\|"
      "\\(is[ \t]+also\\)\\|"
      "\\(is[ \t]+c[ \t]+routine\\)\\|"
      "\\(is[ \t]+empty\\)\\|"
      "\\(is[ \t]+first\\)\\|"
      "\\(is[ \t]+inline\\)\\|"
      "\\(is[ \t]+not[ \t]+a\\)\\|"
      "\\(is[ \t]+not[ \t]+empty\\)\\|"
      "\\(is[ \t]+only\\)\\|"
      "\\(is[ \t]+undefined\\)\\|"
      "\\(state[ \t]+machine\\)\\|"
      "\\(using[ \t]+index\\)\\|"
      "\\(verilog[ \t]+code\\)\\|"
      "\\(verilog[ \t]+function\\)\\|"
      "\\(verilog[ \t]+import\\)\\|"
      "\\(verilog[ \t]+simulator\\)\\|"
      "\\(vhdl[ \t]+simulator\\)"
      "\\>"
      )
	  '(0 font-lock-keyword-face keep))))

  (setq specman-font-lock-keywords-1
	(append specman-font-lock-keywords
		(list
		 ;; Additionally fontify functions
		 (cons (concat "\\<\\(" specman-function-keywords "\\)\\>") 
		       'font-lock-function-name-face)
		 )
		)
	)
  (setq specman-font-lock-keywords-2
	(append specman-font-lock-keywords-1 
		(list
		 ;; Fontify user defined methods
		 ;;; Comment this out as it is horrendously expensive:
		 ;;(cons specman-function-name-regexp '(1 font-lock-function-name-face))
		 ;; Fontify user defined variables
		 (cons specman-variable-definition-regexp '(1 font-lock-variable-name-face))

		 )
		)
	)

  (setq specman-font-lock-keywords-3
	(append specman-font-lock-keywords-2  
		(list
		 ;; Fontify as comments things at the start and end of file
		 '(specman-match-ex-code-regions (0 'font-lock-comment-face t))
		 )
		nil
		)
	)
  )

;; =================================================
;; SPECMAN UTILITY FUNCTIONS
;; =================================================


(defun specman-up-list ()
  "Move up one list, skipping over specman's many comment styles. 
Return point of opener if we are in a list"
  (let ((lim (save-excursion (specman-re-search-backward ";" nil 'move) (point)))
	(nest 1) tb )
    (catch 'skip
      (while (and (> (point) lim)
		  (specman-re-search-backward "[][()]" lim 'move))
	(setq tb (char-syntax (char-after)))
	(cond
	 ((specman-within-comment-p); ignore
	  (specman-skip-backward-comment)
	  )
	 ((= tb ?\( ) (setq nest (1- nest)))
	 ((= tb ?\) ) (setq nest (1+ nest)))
	 )
	(if (= 0 nest)
	    (throw 'skip (point)))
	))))

(defun specman-up-scope ()
  "Move up one list, skipping over specman's many comment styles. Return point of opener
 if we are in a list"
  (let ((lim (save-excursion (specman-beg-of-defun) (point)))
	(nest 1) tb )
    (catch 'skip
      (while (re-search-backward "[{}]" lim 'move)
	(setq tb (char-syntax (char-after)))
	(cond
	 ((specman-within-comment-p); ignore
	  (specman-skip-backward-comment)
	  )
	 ((= tb ?\() (setq nest (1- nest)))
	 ((= tb ?\)) (setq nest (1+ nest)))
	 )
	(if (= 0 nest)
	    (throw 'skip (point)))
	)
      (throw 'skip (point))
      )
    )
  )

(defun specman-within-ex-comment ()
  "Return point if within ex-comment region, else nil."
  (save-excursion
    (if (re-search-backward "\\('>\\)\\|\\(<'\\)" nil 'm)
	(if (match-beginning 2) nil
	  (point))
      (point))))

(defun specman-start-comment (limit)
  "Return point before comment ends if before LIMIT, else nil."
  (when (re-search-forward "^[ \t]*\'\>" limit t)
    (match-beginning 0)))

(defun specman-end-comment (limit)
  "Return point after comment starts if before LIMIT, else nil."
  (re-search-forward "^[ \t]*\<'" limit t))

(defun specman-match-ex-code-regions (limit)
  "Match a non code block, setting match-data and returning t, else nil."
  (when (< (point) limit)
    (let ((start (or (specman-within-ex-comment)
		     (specman-start-comment limit)))
	  (case-fold-search t))
      (when start
	(let ((end (or (specman-end-comment limit) limit)))
	  (set-match-data (list start end))
	  (goto-char end))))))

;; =================================================
;; SPECMAN Hide/show comments
;; =================================================

(require 'hideif)
(defvar specman-comment-hiding nil "Non-nil when text may be hidden.")

(defun specman-toggle-hide-comments ()
  "Toggle the hiding of comments in Specman mode"
  (interactive)
  (specman-outline-comments 
   (not specman-comment-hiding))
)

(defun specman-outline-comments (flag)
  "Hide/or show block comments"
  (interactive)
  (let ((hif-outside-read-only buffer-read-only)
	(inhibit-read-only t))
    (setq selective-display t)
    (setq hide-ifdef-hiding t)
    (hide-ifdef-guts))
    (setq selective-display t)
    (setq specman-comment-hiding (if flag t nil))
    (save-excursion
      (goto-char (point-min))
      (let ((e (point-max)))
	(while (and
		(< (point) e)
		(specman-match-ex-code-regions e))
	  (if flag
	      (hide-ifdef-region (match-beginning 0)
				 (match-end 0))
	    (hif-show-ifdef-region (match-beginning 0)
				    (match-end 0)
				    )
	    )
	  )
	)
      )
    )
;; =================================================
;; SPECMAN Menus
;; =================================================
(defvar specman-xemacs-menu
  '("Specman"
    ("Move"
     ["Beginning of specification"	specman-beg-of-defun t]
     ["End of specification"		specman-end-of-defun t]
     )
    ("Comments"
     ["Insert Comment Header Block"     specman-header t]
     ["Redo/insert comments on every };" specman-redo-endcomments t]
     ["Comment Region"			comment-region t]
     ["UnComment Region"		(comment-region 
					 (region-beginning) 
					 (region-end) '-1) t]
     ["Toggle hiding Comment Blocks"    specman-toggle-hide-comments t]
     ["Multi-line comment insert"	specman-star-comment t]
     )
    "----"
    ["Compile"				compile t]
    ["Next Compile Error"		next-error t]
    "----"
    ["Submit bug report"		specman-submit-bug-report t]
    ["Customize Specman Mode..."	specman-customize t]
    ["Customize Specman Fonts & Colors"	specman-font-customize t]
    )
  "Emacs menu for SPECMAN mode."
  )
(or (string-match "XEmacs" emacs-version)
    (easy-menu-define specman-menu specman-mode-map "Menu for Specman mode"
		      specman-xemacs-menu))

(defun specman-customize ()
  "Link to customize screen for Specman"
  (interactive)
  (customize-group 'specman-mode)
  )

(defun specman-font-customize ()
  "Link to customize fonts used for Specman"
  (interactive)
  (customize-apropos "font-lock-*" 'faces)
  )


(defun specman-beg-of-defun ()
  "Move backward to the beginning of the current function or procedure."
  (interactive)
  (specman-re-search-backward "^[ \t]*<'" nil 'move)
  )
(defun specman-end-of-defun ()
  "Move backward to the beginning of the current function or procedure."
  (interactive)
  (re-search-forward "^[ \t]*'>" nil 'move)
  )

;(setq specman-mode-comment-syntax-table (make-syntax-table))
;(specman-populate-comment-syntax-table specman-mode-comment-syntax-table)
(put 'specman-mode 'font-lock-defaults
     '((specman-font-lock-keywords 
	specman-font-lock-keywords-1
	specman-font-lock-keywords-2
	specman-font-lock-keywords-3)
       nil ;; nil means highlight strings & comments as well as keywords
       nil ;; nil means keywords must match case
       nil ;; specman-mode-comment-syntax-table  ;; use minimal syntax table for font lock
       specman-beg-of-defun ;; function to move to beginning of reasonable region to highlight
       ))

;;; Hacks for FSF
(require 'font-lock)
(defvar specman-need-fld 1)
(defvar font-lock-defaults-alist nil)	;In case we are XEmacs
(if specman-need-fld
    (let ((specman-mode-defaults
	   '((specman-font-lock-keywords 
	      specman-font-lock-keywords-1
	      specman-font-lock-keywords-2
	      specman-font-lock-keywords-3)
	     nil ;; nil means highlight strings & comments as well as keywords
	     nil ;; nil means keywords must match case
	     nil ;; specman-mode-comment-syntax-table  ;; use minimal syntax table for font lock
	     specman-beg-of-defun ;; function to move to beginning of reasonable region to highlight
	     )))
      (setq font-lock-defaults-alist
	    (append
	     font-lock-defaults-alist
	     (list (cons 'specman-mode  specman-mode-defaults)))
	    )
      (setq specman-need-fld 0)))

;; =================================================
;; SPECMAN MODE - MAIN FUNCTION
;; =================================================
(defun specman-mode ()
  "Major mode for editing Specman code.

Automatically indents and colorizes E code.

To submit a problem report, enter \\[specman-submit-bug-report] from a
specman mode buffer. This automatically sets up a mail buffer with
version information already added. You just need to add a description
of the problem, including a reproducible test case, and send the
message.

To tune the fonts and colors to your preference, enter
\\[specman-font-customize].

To tune other user tunable options, enter
\\[specman-customize].

Key Bindings:
=================================
\\{specman-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map specman-mode-map)
  (setq major-mode 'specman-mode)
  (setq mode-name "Specman")
  (setq write-file-hooks nil)
  (setq local-abbrev-table specman-mode-abbrev-table)
  (setq specman-mode-syntax-table (make-syntax-table))
  (specman-populate-syntax-table specman-mode-syntax-table)
  ;; add extra comment syntax
  (specman-setup-dual-comments specman-mode-syntax-table)
  (set-syntax-table specman-mode-syntax-table)
  ;; initializations
  (setq specman-mode-comment-syntax-table (make-syntax-table))
  (specman-populate-comment-syntax-table specman-mode-comment-syntax-table)
  (make-local-variable 'parse-sexp-ignore-comments)
  (setq parse-sexp-ignore-comments t)
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'specman-indent-line)
  
  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'block-comment-start)
  (make-local-variable 'block-comment-end)
  (make-local-variable 'comment-multi-line)
  (make-local-variable 'comment-start-skip)
  (make-local-variable 'comment-column)
  (make-local-variable 'normal-auto-fill-function)
  (make-local-variable 'indent-region-function)
  (make-local-variable 'comment-indent-function)
  (setq comment-indent-function 'specman-comment-indent)
  (setq comment-start "// "
	comment-end ""
	comment-column 48
	comment-multi-line t
	; comment-start-skip "\\(// *\\|-- *\\)"
	normal-auto-fill-function 'specman-do-auto-fill
	indent-region-function 'specman-indent-region
	)

  (make-local-variable 'case-fold-search)
  (make-local-variable 'indent-region-function)
  (setq indent-region-function 'specman-indent-region)
  (setq case-fold-search t)

  ;; setup the comment indent variable in a Emacs version portable way
  ;; ignore any byte compiler warnings you might get here
  (if (boundp 'comment-indent-function)
      (progn
	(make-local-variable 'comment-indent-function)
	(setq comment-indent-function 'specman-comment-indent))
    (make-local-variable 'comment-indent-function)
    (setq comment-indent-function 'specman-comment-indent))
  ;; Make a menu bar
  (if (string-match "XEmacs" emacs-version)
      (progn
        (if (and current-menubar
                 (not (assoc "Specman" current-menubar)))
            (progn
              (set-buffer-menubar (copy-sequence current-menubar))
              (add-submenu nil specman-xemacs-menu))) ))
  ;; Call imenu to make list of methods and variables 
  ;; Tell imenu how to handle verilog.
  (make-local-variable 'imenu-generic-expression)
  (setq imenu-generic-expression specman-imenu-generic-expression)
  (imenu-add-to-menubar "Specman-Index")
  (run-hooks 'specman-mode-hook)
  )

;; =================================================
;; SPECMAN SEARCH BACK
;; =================================================

(defconst specman-code-start-regexp "<\\'"
  "`specman-code-start-regexp'.")

;; =================================================
;; SPECMAN INDENTATION
;; =================================================

(defun specman-comment-indent (&optional arg)
  "return the column number the line should be indented to."
  (cond
   ((specman-in-line-comment-p)
    (save-excursion
      (re-search-backward comment-start-skip nil t)
      (current-column)))
   ( comment-column comment-column )
   (t
    (save-excursion
      (re-search-backward comment-start-skip nil t)
      (current-column))
    )
   )
  )

;; SPECMAN - MAIN INDENT FUNCTION
(defun specman-indent-line-keep-pos ()
  (let
    (
     (start-char (start-char-pos))
     (curr-pos (current-column))
     offset new-start-pos new-pos
     )
    (setq offset (- curr-pos start-char))
    (specman-indent-line)
    (setq new-start-pos (start-char-pos))
    (setq new-pos (+ new-start-pos offset))
    (move-to-column new-pos)
    )
)

;; SPECMAN - INDENT FULL REGION
(defun specman-indent-region (beg-region end-region)
  (interactive)
  (message "Wait while indenting .... ")
  (save-excursion
    (goto-char beg-region)
    (when (and beg-region end-region)
      (let 
	  ((curr-line 0)
	   (num-lines 1)
	   (start-line-point 0))
	(goto-char beg-region)
	(beginning-of-line)
	(setq start-line-point (point))
	(goto-char end-region)
	(beginning-of-line)
	(while (> (point) start-line-point)
	  (setq num-lines (+ num-lines 1))
	  (forward-line -1)
	  (beginning-of-line))
	(goto-char start-line-point)
	(while (< curr-line num-lines)
	  (unless (specman-empty-line-p) (specman-indent-line))
	  (setq curr-line (+ curr-line 1))
	  (when (< curr-line num-lines) (forward-line 1)))
	(goto-char start-line-point)))
    )
  (message nil))


;; =================================================
;; SPECMAN IDENTIFY LINE TYPES
;; =================================================

(defconst *comment-line-re* "^[ \t]*\\(--M.*\\|//.*\\)$")
(defun specman-comment-line-p ()
  (save-excursion
	(beginning-of-line)
	(looking-at *comment-line-re*)))

(defun specman-line-offset ()
  "Return offset for this line based on context"
  (let* ((lim  (save-excursion 
		 (specman-up-scope)))
	 (here (save-excursion 
		 (forward-to-indentation 0)
		 (point)))
	 (last (save-excursion 
		 (if (specman-re-search-backward ";" lim t)
		     (progn (forward-char) 
			    (specman-forward-ws)
			    (point))
		   nil)))
	 (offset (save-excursion 
		   (goto-char here)
		   (specman-scope-offset lim))))
    (if (or (not last)
	    (<= here last))
	offset
      (+ specman-continued-line-offset offset))))

(defun specman-beg-of-statement ()
  "Move to start of statement and return point"
  (let* ((lim  (save-excursion 
		 (specman-up-scope)))
	 (last (save-excursion 
		 (if (specman-re-search-backward ";" lim t)
		     (progn (forward-to-indentation 1)
			    (specman-forward-ws)
			    (point))
		   (progn
		     (goto-char lim)
		     (skip-syntax-forward "w.()")
		     (specman-forward-ws)
		     (point))))))
    last))

(defun specman-backward-ws (&optional bound)
  "Backward skip over syntactic whitespace"
  (skip-chars-backward " \t\n")
  (while (cond 
	  ;; true if we are in a -- .. EOL region
	  ((re-search-backward "--" (specman-beg-of-line-pos) 't)
	   (skip-chars-backward " \n\t"))
	  ;; true if we are in a // .. EOL region
	  ((re-search-backward "//" (specman-beg-of-line-pos) 't)
	   (skip-chars-backward " \n\t"))
	  (t
	   nil))))
  
(defun specman-forward-ws (&optional bound)
  "Forward skip over syntactic whitespace"
  (skip-chars-forward " \t\n")
  (while 
      (cond 
       ((looking-at "[ \t\n]")
	(skip-chars-forward "[ \t\n]"))
       ((looking-at "--")
	(forward-to-indentation 1))
       ((looking-at "//")
	(forward-to-indentation 1))
       ((looking-at "/\\*")
	(search-forward "*/"))
       (t
	nil))))
  
(defun specman-semicolon-line-p ()
  (let ((lim (specman-point 'eol)))
    (specman-re-search-forward ";" lim t)))

(defconst *optional-comment-part-re* "[ \t]*\\(\\(--\\|//\\).*\\)?$")
(defun specman-known-canonic-line-p()
  (save-excursion
	(beginning-of-line)
	(or
	 (looking-at (concat "^\\(.*[ \t\)]+\\)?then" 
			     *optional-comment-part-re*))
	 )))


(defconst *comment-section-line-re* "^.*\\(--.*\\|//.*\\)$")

(defconst *closer-line-re* "^[ \t]*[}].*$")

(defun specman-closer-p ()
  (save-excursion 
    (forward-line 0)
    (if (looking-at *closer-line-re*)
	(specman-up-scope)
      nil)))

(defconst *opener-line-re* "^.*[{][^{}]*$")

(defconst *starts-opener-line-re* "^[ \t]*[{].*$")
(defconst *open-close-line-re* 
	  "^[ \t]*[{].*[}][ \t]*[;]?[ \t]*\\(--.*\\|//.*\\)?$")

(defconst *internal-open-close-line-re* 
	  "^\\([^{}\n]*[{][^{}\n]*[}]\\)+[^{}\n]*$")

(defconst *single-comment-line* "^[ \t]*\\(//\\|--\\).*$")

(defun specman-single-comment-line-p ()
  (interactive)
  (save-excursion
	(beginning-of-line)
	(looking-at *single-comment-line*)))


(defun specman-starts-open-block-line-p ()
  (interactive)
  (and
   (not (specman-single-comment-line-p))
   (save-excursion
	 (beginning-of-line)
	 (looking-at *starts-opener-line-re*))))


(defconst *internal-close-open-line-re* 
      "^\\([^{}\n]*[}][^{}\n]*[{]\\)[^{}\n]*$")
  
(defun specman-begin-area-mark-line-p ()
  (save-excursion
    (beginning-of-line)
    (looking-at "^[ \t]*<'[ \t]*$")))


(defun specman-finish-area-mark-line-p ()
  (save-excursion
	(beginning-of-line)
	(looking-at "^[ \t]*'>[ \t]*$")))


;; SPECMAN - MAIN GET LINE TYPE
(defconst specman-offsets-alist-default
  '((string                . -1000)
    (block-open            . 0)
    (block-close           . 0)
    (statement             . 0)
    (statement-cont        . specman-lineup-statement-cont)
    (statement-block-intro . +)
    (statement-case-intro  . +)
    (case-alternative      . +)
    (comment               . specman-lineup-comment)
    (arglist-intro         . +)
    (arglist-cont          . 0)
    (arglist-cont-nonempty . specman-lineup-arglist)
    (arglist-close         . specman-lineup-arglist)
    (entity                . 0)
    (configuration         . 0)
    (package               . 0)
    (architecture          . 0)
    (package-body          . 0)
    )
  "Default settings for offsets of syntactic elements.
Do not change this constant!  See the variable `specman-offsets-alist' for
more information.")

(defvar specman-offsets-alist (copy-alist specman-offsets-alist-default)
  "*Association list of syntactic element symbols and indentation offsets.
Each cons cell in this list has the form:
    (SYNTACTIC-SYMBOL . OFFSET)")

(defvar specman-syntactic-context nil
  "Buffer local variable containing syntactic analysis list.")
(make-variable-buffer-local 'specman-syntactic-context)

(defmacro specman-add-syntax (symbol &optional relpos)
  "Append syntax in SYMBOL to the syntax list."
  `(setq specman-syntactic-context
	 (cons (cons ,symbol ,relpos) specman-syntactic-context)))

(defun specman-describe-point  ()
  (interactive)
  (let* ((syntax (specman-get-syntactic-context))
	(indent (specman-get-offset syntax)))
    (message "syntax: %s, indent= %d" syntax indent))
  )

(defun specman-get-syntactic-context ()
  (let ((p))
    (save-excursion
      (beginning-of-line)
      (cond
       ((specman-line-within-string-p)	;1
	(list 'line-within-string -1 0))       ;; "line-within-string"
       
       ((specman-begin-area-mark-line-p) ;2
	(list 'begin-area-mark 0 0))           ;; "begin-area-mark"
       
       ((specman-finish-area-mark-line-p) ;3
	(list 'finish-area-mark 0 0))          ;; "finish-area-mark"
       
       ((specman-line-within-comment-p)	;4
	(list 'line-within-comment-area 'C 0)) ;; "line-within-comment-area" 
       
       ((save-excursion (setq p (specman-up-list)))
	(list 'line-within-paren 'p p))

       ((setq p (specman-closer-p))	;5
	(list 'closer 'p p ))          
       
       ((setq p (specman-line-offset))	;6
;;	(if (looking-at "[ \t]*keep[ \t]*soft")
;;	    (list 'continued-line 'c (+ specman-basic-offset p))
	  (list 'continued-line 'c p ))  ;; "continued-line" 
;;	)  
       
       ((save-excursion (setq p (specman-up-scope)))
	(list 'line-within-paren 'p p))

       (t 
	(list 'unknown '= 0))
       ))))
(defvar specman-echo-syntactic-information-p nil)


;; 
(defun specman-indent-line ()
  "Indent the current line as SPECMAN code.  Returns the amount of
indentation change."
  (interactive)
  (let* ((pos (- (point-max) (point)))
	 (syntax (specman-get-syntactic-context))
	 (indent (specman-get-offset syntax))
	 (shift-amt  (- indent (current-indentation))))
    (and specman-echo-syntactic-information-p
	 (message "syntax: %s, indent= %d" syntax indent))
    (unless (zerop shift-amt)
      (delete-region (specman-point 'bol) (specman-point 'boi))
      (beginning-of-line)
      (indent-to indent))
    (if (< (point) (specman-point 'boi))
	(back-to-indentation)
      ;; If initial point was within line's indentation, position after
      ;; the indentation.  Else stay at same point in text.
      (when (> (- (point-max) pos) (point))
	(goto-char (- (point-max) pos))))
    (run-hooks 'specman-special-indent-hook)
    shift-amt))

(defvar specman-strict-syntax-p t)

(defun specman-scope-offset (parenloc)
  "determine the amount to indent code based on the enclosing scope "
  (save-excursion
    (back-to-indentation)
    (let ((c (char-after)))
      (goto-char parenloc)
      (cond
       (; Open scope
	(char= (char-after) ?\{ )
	(goto-char (specman-beg-of-statement))
	(if (and c (char= c ?\}))
	    (current-column)
	  (progn
	    (+ (current-column) 
	       specman-basic-offset))))

       (; Inside ( )
	(char= (char-after) ?\( )
	(unless specman-line-up-paren
	    (forward-to-indentation 0))
	(if (and c (char= c ?\)))
	    (current-column)
	  (progn
	    (forward-char 1)
	    (skip-chars-forward " \t")
	    (current-column))))

       (; Inside [ ]
	(char= (char-after) ?\[ )
	(unless specman-line-up-bracket
	    (forward-to-indentation 0))
	(if (and c (char= c ?\]))
	    (current-column)
	  (progn
	    (+ (current-column) 
	       specman-basic-offset))))
       (; Everything else
	t
	(current-column))
       )
      )
    )
  )

(defun specman-get-offset (syntax)
  "Get offset from SYNTAX which is a cons cell of the form:
\(SYMBOL . RELPOS).  The symbol is matched against
specman-offsets-alist and the offset found there is either returned,
or added to the indentation at RELPOS.  If RELPOS is nil, then
the offset is simply returned."
  (let* (;;(symbol (nth 0 syntax))
	 (offset (nth 1 syntax))
	 (parenloc (nth 2 syntax))
	 )
    ;; offset can be a number, a function, a variable, or one of the
    ;; symbols + or -
    (cond
     ((eq offset 'p)  (setq offset (specman-scope-offset parenloc)))
     ((eq offset '=)  (setq offset (current-indentation)))
     ((eq offset 'c)  (setq offset parenloc))
     ((eq offset 'C)  (progn
			(setq offset 
			      (save-excursion 
				(beginning-of-line)
				(if (specman-skip-backward-comment-or-string)
				    (current-indentation)
				  (progn
				    (forward-line -1) 
				    (end-of-line)
				    (if (specman-skip-backward-comment-or-string)
					(current-indentation)
				      0)))))))
     ((eq offset '-)  (setq offset (- specman-basic-offset)))
     ((eq offset '++) (setq offset (* 2 specman-basic-offset)))
     ((eq offset '--) (setq offset (* 2 (- specman-basic-offset))))
     ((and (not (numberp offset)) (fboundp offset))
      (setq offset (funcall offset)))
     ((not (numberp offset)) (setq offset (eval offset)))
     )
    offset))
;; =================================================
;; SPECMAN - AUTO ENDCOMMENTS
;; =================================================
(defun kill-existing-comment ()
  "Kill autocomment on this line."
  (save-excursion
    (let* (
	   (e (progn
		(end-of-line)
		(point)))
	   (b (progn
		(beginning-of-line)
		(search-forward "//" e t))))
      (if b
	  (delete-region (- b 2) e)))))
(defvar specman-action-re
  "\\<\\(if\\|repeat\\|while\\|for\\|struct\\|unit\\|extend\\|gen\\)\\>[ \t]+\\([^{]+\\){") 
(defun specman-set-auto-endcomments ( &optional kill-existing-comment nocheck)
  "Add ending comment after a }; indicating what block is thereby closed.
With KILL-EXISTING-COMMENT, remove what was there before."
  (interactive)
  (save-excursion
    (cond
     (; Comment close block
      (and (or
	    nocheck
	    (looking-at "};")
	    (progn (backward-char 2)
		   (looking-at "};")))
	   (or kill-existing-comment
	       (not (save-excursion
		      (let ((boi  (beginning-of-line)))
			(end-of-line)
			(search-backward "//" boi t))))))
      (let ((err 't)
	    (str "UNMATCHED!!")
	    here end )
	(save-excursion
	  (specman-up-scope)
	  (setq here (point))
	  (goto-char (specman-beg-of-statement))

	  (setq str
		(cond 
		 (; method
		  (looking-at specman-function-name-regexp)
		  (let ((beg (match-beginning 1))
			(end (match-end 1)))
		    (buffer-substring beg end)))
		 (; else
		  (looking-at "}[ \t\n]*else")
		  (goto-char (match-beginning 0))
		  (specman-up-scope)
		  (setq end (point))
		  (goto-char (specman-beg-of-statement))
		  (setq here (point))
		  (concat "! " (buffer-substring here end)))
		 (; if
		  (looking-at "\\(.*\\){")
		  (let ((beg (match-beginning 1))
			(end here))
		    (buffer-substring beg end)))
		 (;
		  t
		  " ")
		 )))
	(setq err nil)
	(end-of-line)
	(if kill-existing-comment (kill-existing-comment))
	(delete-horizontal-space)
	(insert 
	 (concat " // " 
		 (if (> (length str) 15)
		     (concat (substring str 0 15 ) "..." )
		   str)))
	(if err (ding 't))
	)))))
(defun specman-electric-semi ()
  "Insert `;' character and reindent the line."
  (interactive)
  (if specman-semi-is-electric
      (progn
	(if (specman-in-comment-or-string-p)
	    (insert last-command-char)
	  (if (char= (char-before) ?\} )
	      (progn
		(insert last-command-char)
		(backward-char 2)
		(specman-set-auto-endcomments 't 't))
	    (insert last-command-char))
	  (forward-to-indentation 0)
	  (specman-indent-line))
	(if specman-auto-newline
	    (progn
	      (end-of-line)
	      (delete-horizontal-space)
	      (newline))))
    (insert last-command-char)))


(defun specman-redo-endcomments (&optional arg)
  "Label '};' tokens withthe reason for the end
With ARG, first kill any existing labels."
  (interactive)
  (let ((cnt 0)
	(oldpos (point))
	(b (progn
	     (specman-beg-of-defun)
	     (point-marker)))
	(e (progn
	     (specman-end-of-defun)
	     (point-marker)))
	)
    (goto-char (marker-position b))
    (if (> (- e b) 200)
	(message  "Relabeling code..."))
    (while (and
	    (> (marker-position e) (point))
	    (specman-re-search-forward "};" nil 'move))
      (goto-char (match-beginning 0))
      (specman-set-auto-endcomments 't 't)
      (end-of-line)
      (delete-horizontal-space)
      (setq cnt (1+ cnt))
      (if (= 9 (% cnt 10))
	  (message "%d..." cnt))
      )
    (goto-char oldpos)
    (if (or
	 (> (- e b) 200)
	 (> cnt 20))
	(message  "%d lines autocommented" cnt))
    ))

;; =================================================
;; SPECMAN - NEW LINE
;; =================================================
(defun specman-new-line ()
  (interactive)
  (let* ((syntax (specman-get-syntactic-context))
	 (type (nth 0 syntax)))
    (newline)
    (when 
	(or
	 (eq type 'close-block)
	 (eq type 'open-block))
      ;; when the prev line has a opening/closing bracket, 
      ;; ident it also.
      (forward-line -1)
      (beginning-of-line)
      (specman-indent-line)
      (forward-line 1))
    ;; indent the new line
    (specman-indent-line)))

(defun specman-keep-new-line ()
  (interactive)
  (newline))

(defun specman-soft-new-line ()
  (interactive)
  (specman-indent-line)
  (forward-line 1)
  (specman-goto-first-char))


(defun specman-softest-new-line ()
  (interactive)
  (specman-indent-line)
  (specman-goto-first-char))


;; =================================================
;; SPECMAN - INSERT SPECIAL CHARS
;; =================================================
(defun specman-insert-curly-opener()
  (interactive)
  (insert "{")
  (and specman-curly-opener-is-electric
       (specman-indent-line))
  )

(defun specman-electric-curly-closer()
  (interactive)
  (insert "}")
  (and specman-curly-closer-is-electric
       (specman-indent-line-keep-pos))
)
(defun specman-electric-curly-opener()
  (interactive)
  (insert "{")
  (and specman-curly-closer-is-electric
       (specman-indent-line-keep-pos))
)

;;;
;;; provide a specman-header function.
;;; Customization variables:
;;;
(defcustom specman-date-scientific-format nil
  "*If non-nil, dates are written in scientific format (e.g. 1997/09/17),
in european format otherwise (e.g. 17.09.1997). The braindead american
format (e.g. 09/17/1997) is not supported."
  :group 'specman
  :type 'boolean
  )

(defcustom specman-company "ACME Company"
  "*Default name of Company for specman header. If set will become buffer local. "
  :group 'specman
  :type 'string  
  )

(defcustom specman-project "Roadrunner"
  "*Default name of Project for specman header. If set will become buffer local."
  :group 'specman
  :type 'string  
  )


(defun specman-header ()
  "Insert a standard Specman file header."
  (interactive)
  (let ((start (point)))
  (insert "\
//-----------------------------------------------------------------------------
// Title         : <title>
// Project       : <project>
//-----------------------------------------------------------------------------
// File          : <filename>
// Author        : <author>
// Created       : <credate>
// Last modified : <moddate>
//-----------------------------------------------------------------------------
// Description :
// <description>
//-----------------------------------------------------------------------------
// Copyright (c) <copydate> by <company>. This model is the confidential and
// proprietary property of <company> and the possession or use of this
// file requires a written license from <company>.
//------------------------------------------------------------------------------
// Modification history :
// <modhist>
//-----------------------------------------------------------------------------

")
    (goto-char start)
    (search-forward "<filename>")
    (replace-match (buffer-name) t t)
    (search-forward "<author>") (replace-match "" t t)
    (insert (user-full-name))
    (insert "  <" (user-login-name) "@" (system-name) ">")
    (search-forward "<credate>") (replace-match "" t t)
    (specman-insert-date)
    (search-forward "<moddate>") (replace-match "" t t)
    (specman-insert-date)
    (search-forward "<copydate>") (replace-match "" t t)
    (specman-insert-year)
    (search-forward "<modhist>") (replace-match "" t t)
    (specman-insert-date)
    (insert " : created")
    (goto-char start)
    (let (string)
      (setq string (read-string "title: "))
      (search-forward "<title>")
      (replace-match string t t)
      (setq string (read-string "project: " specman-project))
      (make-variable-buffer-local 'specman-project)
      (setq specman-project string)
      (search-forward "<project>")
      (replace-match string t t)
      (setq string (read-string "Company: " specman-company))
      (make-variable-buffer-local 'specman-company)
      (setq specman-company string)
      (search-forward "<company>")
      (replace-match string t t)
      (search-forward "<company>")
      (replace-match string t t)
      (search-forward "<company>")
      (replace-match string t t)
      (search-backward "<description>")
      (replace-match "" t t)
  )))

;; specman-header Uses the specman-insert-date function

(defun specman-insert-date ()
  "Insert date from the system."
  (interactive)
  (let ((timpos))
    (setq timpos (point))
    (if specman-date-scientific-format
	(shell-command  "date \"+@%Y/%m/%d\"" t)
      (shell-command  "date \"+@%d.%m.%Y\"" t))
    (search-forward "@")
    (delete-region timpos (point))
    (end-of-line))
    (delete-char 1)
  )
(defun specman-insert-year ()
  "Insert year from the system."
  (interactive)
  (let ((timpos))
    (setq timpos (point))
    (shell-command  "date \"+@%Y\"" t)
    (search-forward "@")
    (delete-region timpos (point))
    (end-of-line))
  (delete-char 1)
  )
  

;;;
;;; Bug reporting
;;;
(require 'reporter)

(defun specman-submit-bug-report ()
  "Submit via mail a bug report on lazy-lock.el."
  (interactive)
  (let ((reporter-prompt-for-summary-p t))
    (reporter-submit-bug-report
     "specman-mode-bugs@surefirev.com"
     (concat "specman-mode v" (substring specman-mode-version 12 -3))
     '(
       specman-basic-offset
       specman-continued-line-offset
       specman-line-up-bracket
       specman-line-up-paren
       specman-auto-newline
       specman-tab-width
       specman-date-scientific-format
       specman-company
       specman-project
       )
     nil nil
     (concat "Hello,

I want to report a bug.  I've read the `Bugs' section of `Info' on
Emacs, so I know how to make a clear and unambiguous report.  To get
to that Info section, I typed

M-x info RET m " invocation-name " RET m bugs RET

Before I go further, I want to say that Specman mode has changed my
life.  I save so much time, my files are colored nicely, my co workers
finally respect my coding ability... until now.  I'd really appreciate
anything you could do to help me out with this extremely minor
deficiency in the product.

To reproduce the bug, start a fresh Emacs via " invocation-name "
-no-init-file -no-site-file'.  In a new buffer, in specman mode, type
the code included below.

Given those lines, I expected 

  TELL ME WHAT YOU EXPECTED

to happen;
but instead, 

  TELL ME THE BAD THING THAT HAPPENED

happens!.

  GIVE ME CODE SUFFICIENT TO DEMONSTRATE THE PROBLEM

== The code: =="))))

(provide 'specman-mode)
(run-hooks 'specman-mode-load-hook)
 
;;; specman-mode.el ends here
(defvar word-across-newline)


; Put FSF one in until I can one or the other working properly, then the
; other one is history.
(defun specman-do-auto-fill ()
  (let (fc justify
	   ;; bol
	   give-up
	   (fill-prefix fill-prefix))
    (if (or (not (setq justify (current-justification)))
	    (null (setq fc (current-fill-column)))
	    (and (eq justify 'left)
		 (<= (current-column) fc))
	    (save-excursion (beginning-of-line)
			    ;; (setq bol (point))
			    (and auto-fill-inhibit-regexp
				 (looking-at auto-fill-inhibit-regexp))))
	nil ;; Auto-filling not required
      (if (memq justify '(full center right))
	  (save-excursion (unjustify-current-line)))

      ;; Choose a fill-prefix automatically.
      (setq fill-prefix (specman-return-enclosing-comment-prefix))
      (if (and adaptive-fill-mode
	       (or (null fill-prefix) (string= fill-prefix "")))
	  (let ((prefix
		 (fill-context-prefix
		  (save-excursion (backward-paragraph 1) (point))
		  (save-excursion (forward-paragraph 1) (point))
		  ;; Don't accept a non-whitespace fill prefix
		  ;; from the first line of a paragraph.
		  "^[ \t]*$")))
	    (and prefix (not (equal prefix ""))
		 (setq fill-prefix prefix))))

      (while (and (not give-up) (> (current-column) fc))
	;; Determine where to split the line.
	(let ((fill-point
	       (let ((opoint (point))
		     bounce
		     (first t))
		 (save-excursion
		   (move-to-column (1+ fc))
		   ;; Move back to a word boundary.
		   (while (or first
			      ;; If this is after period and a single space,
			      ;; move back once more--we don't want to break
			      ;; the line there and make it look like a
			      ;; sentence end.
			      (and (not (bobp))
				   (not bounce)
				   sentence-end-double-space
				   (save-excursion (forward-char -1)
						   (and (looking-at "\\. ")
							(not (looking-at "\\.  "))))))
		     (setq first nil)
		     (skip-chars-backward "^ \t\n")
		     ;; If we find nowhere on the line to break it,
		     ;; break after one word.  Set bounce to t
		     ;; so we will not keep going in this while loop.
		     (if (bolp)
			 (progn
			   (re-search-forward "[ \t]" opoint t)
			   (setq bounce t)))
		     (skip-chars-backward " \t"))
		   ;; Let fill-point be set to the place where we end up.
		   (point)))))
	  ;; If that place is not the beginning of the line,
	  ;; break the line there.
	  (if (save-excursion
		(goto-char fill-point)
		(not (bolp)))
	      (let ((prev-column (current-column)))
		;; If point is at the fill-point, do not `save-excursion'.
		;; Otherwise, if a comment prefix or fill-prefix is inserted,
		;; point will end up before it rather than after it.
		(if (save-excursion
		      (skip-chars-backward " \t")
		      (= (point) fill-point))
		    (funcall comment-line-break-function t)
		  (save-excursion
		    (goto-char fill-point)
		    (funcall comment-line-break-function t)))
		;; Now do justification, if required
		(if (not (eq justify 'left))
		    (save-excursion
		      (end-of-line 0)
		      (justify-current-line justify nil t)))
		;; If making the new line didn't reduce the hpos of
		;; the end of the line, then give up now;
		;; trying again will not help.
		(if (>= (current-column) prev-column)
		    (setq give-up t)))
	    ;; No place to break => stop trying.
	    (setq give-up t))))
      ;; Justify last line.
      (justify-current-line justify t t)
      t)))