hets/CSL/CSLMode.el

	CSLMode.el revision 0f541fef46255a09d1143a9cbf3e2dbafb610923
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder;; Creating a new menu pane in the menu bar to the right of "Tools" menu
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens Elkner;; A keymap is suitable for menu use if it has an overall prompt string, which describes the purpose of the menu.
e6d40133bc9f858308654afb1262b8b483ec5922Till Mossakowski;; essentially: define-key map fake-key '(item command), where fake-key is of the form [menu-bar mymenu nl] and defines key nl in mymenu which must exist
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu Prodescu(define-key-after
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder  global-map
3f69b6948966979163bdfe8331c38833d5d90ecdChristian Maeder  [menu-bar enclmenu]
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder  (cons "ENCL" (make-sparse-keymap "encl menu"))
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder  'tools)
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder
819ef30d291cb3d17790271f901b0ca03f2b783fChristian Maeder
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder;; extract all spec definitions
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder(defun extractspecs ()
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder  (interactive)
e5bf1cecd6f65e5c36b033d9d3f93938846a9ec9cmaeder  (save-excursion
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (let
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (p1 specs)
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder      (goto-char (point-min))
805c5dce5ed0d985e5236fe756096377b854e02fChristian Maeder      (while (search-forward "spec" nil t)
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (skip-chars-forward " ")
e5bf1cecd6f65e5c36b033d9d3f93938846a9ec9cmaeder    (setq p1 (point))
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (forward-word)
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (push (buffer-substring-no-properties p1 (point)) specs)
e5bf1cecd6f65e5c36b033d9d3f93938846a9ec9cmaeder    )
e5bf1cecd6f65e5c36b033d9d3f93938846a9ec9cmaeder      specs
e5bf1cecd6f65e5c36b033d9d3f93938846a9ec9cmaeder      )
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    )
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder  )
2c6fe006c1088b8a25836fd4b7fa1f687213dba2Christian Maeder
2c6fe006c1088b8a25836fd4b7fa1f687213dba2Christian Maeder;; extract all imports
2c6fe006c1088b8a25836fd4b7fa1f687213dba2Christian Maeder(defun extractgets ()
812ee1f62e0e0e7235f3c05b41a0b173497b54ffChristian Maeder  (interactive)
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder  (save-excursion
4233c2e78d3486e57ebd84bf8f82331ed51a636bChristian Maeder    (let
819ef30d291cb3d17790271f901b0ca03f2b783fChristian Maeder    (p1
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder     specs
819ef30d291cb3d17790271f901b0ca03f2b783fChristian Maeder     )
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder      (goto-char (point-min))
819ef30d291cb3d17790271f901b0ca03f2b783fChristian Maeder      (while (search-forward "get" nil t)
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (skip-chars-forward " ")
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (setq p1 (point))
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (forward-word)
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (push (buffer-substring-no-properties p1 (point)) specs)
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    ;; comma separated lisp
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (skip-chars-forward " ")
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder    (while (string= (buffer-substring-no-properties (point) (+ 1 (point))) ",")
e5bf1cecd6f65e5c36b033d9d3f93938846a9ec9cmaeder      (skip-chars-forward " ")
e5bf1cecd6f65e5c36b033d9d3f93938846a9ec9cmaeder      (setq p1 (+ 1 (point)))
e5bf1cecd6f65e5c36b033d9d3f93938846a9ec9cmaeder      (forward-word)
e5bf1cecd6f65e5c36b033d9d3f93938846a9ec9cmaeder      (push (buffer-substring-no-properties p1 (point)) specs)
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder      (skip-chars-forward " ")
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder      )
819ef30d291cb3d17790271f901b0ca03f2b783fChristian Maeder    )
185500d23409c9c62a499b32f43b8898119540b4Christian Maeder      specs
      )
    )
  )

(defun refresh-specmenu2 ()
  (interactive)
  (let
      ((entries (sort (append (extractspecs) (extractgets)) 'string<))
       currentsym
       )

    ;; delete the match menu
    (global-unset-key [menu-bar enclmenu match])
    ;; generate match menu
    (define-key-after global-map [menu-bar enclmenu match] (cons "Match" (make-sparse-keymap)) 'kill-buffer)

    ;; generate subentries
    (dolist (item entries)
      (setq currentsym (gensym))
      (define-key global-map (vector 'menu-bar 'enclmenu 'match currentsym) (cons item (make-sparse-keymap)))
      ;; submenus
      (dolist (item2 entries)
    (setq currentsym2 (gensym))
    (define-key global-map (vector 'menu-bar 'enclmenu 'match currentsym currentsym2) (cons item2 (make-sparse-keymap)))
    (dolist (item3 '("Show match" "Export parameter"))
    (define-key global-map (vector 'menu-bar 'enclmenu 'match currentsym currentsym2 (gensym))
      (cons item3 `(lambda () (interactive) (run-csl ,item ,item2 ,item3))))
    )

    )
    (define-key global-map (vector 'menu-bar 'enclmenu 'match currentsym (gensym)) (cons "--" nil))
    (define-key global-map (vector 'menu-bar 'enclmenu 'match currentsym (gensym)) (cons "Select design spec" nil))

      )
    (define-key global-map (vector 'menu-bar 'enclmenu 'match (gensym)) (cons "--" nil))
    (define-key global-map (vector 'menu-bar 'enclmenu 'match (gensym)) (cons "Select pattern spec" nil))
    )
  )

(defun refresh-evalmenu ()
  (interactive)
  (let
      ((entries (sort (append (extractspecs) (extractgets)) 'string<))
       currentsym
       )

    ;; delete the match menu
    (global-unset-key [menu-bar enclmenu eval])
    ;; generate match menu
    (define-key-after global-map [menu-bar enclmenu eval] (cons "Evaluate" '(lambda () (interactive) (run-eval "FlangeComplete"))))
    )
  )

(defun refresh-matchmenu ()
  (interactive)
  (let
      ((entries (sort (append (extractspecs) (extractgets)) 'string<))
       currentsym
       )

    ;; delete the match menu
    (global-unset-key [menu-bar enclmenu match])
    ;; generate match menu
    (define-key-after global-map [menu-bar enclmenu match] (cons "Match" (make-sparse-keymap)) 'kill-buffer)


    (refresh-specmenu entries 'match 'run-match '("Show match" "Export parameter"))
  )
)


(defun refresh-specmenu (entries menusym runfun runlist)
  (interactive)

    ;; generate subentries
    (dolist (item entries)
      (setq currentsym (gensym))
      (define-key global-map (vector 'menu-bar 'enclmenu menusym currentsym) (cons item (make-sparse-keymap)))
      ;; submenus
      (dolist (item2 entries)
    (setq currentsym2 (gensym))
    (define-key global-map (vector 'menu-bar 'enclmenu menusym currentsym currentsym2) (cons item2 (make-sparse-keymap)))
    (dolist (item3 runlist)
    (define-key global-map (vector 'menu-bar 'enclmenu menusym currentsym currentsym2 (gensym))
      (cons item3 `(lambda () (interactive) (,runfun ,item ,item2 ,item3))))
    )

    )
    (define-key global-map (vector 'menu-bar 'enclmenu menusym currentsym (gensym)) (cons "--" nil))
    (define-key global-map (vector 'menu-bar 'enclmenu menusym currentsym (gensym)) (cons "Select design spec" nil))

      )
    (define-key global-map (vector 'menu-bar 'enclmenu menusym (gensym)) (cons "--" nil))
    (define-key global-map (vector 'menu-bar 'enclmenu menusym (gensym)) (cons "Select pattern spec" nil))
  )


(defun prepare-buffer (name)
  (let ((buff (get-buffer-create name)))
    (with-current-buffer buff (delete-region (point-min) (point-max)))
    buff)
  )

(defun run-match (spec1 spec2 trans)
  (interactive)
  (message "Matching selected pattern with the design spec")
;; example command
;; matchcad /tmp/flange.het -sMatch -pFlangePattern -dComponent
;  (message (concatenate 'string "asd" (buffer-file-name (current-buffer))))
;  (call-process "/bin/ls" nil (get-buffer-create "*Match-Result*") t "-lh" "/tmp/")

  (call-process "matchcad" nil (prepare-buffer "*Match-Result*") t
        "-sMatch"
        "-p" spec1
        "-d" spec2
        (if (string= trans "Show match") "" "-t")
        (buffer-file-name (current-buffer)))

  (switch-to-buffer (get-buffer "*Match-Result*"))

  (when (string= trans "Export parameter")
    (set-visited-file-name (concatenate 'string (make-temp-file "flangeParams") ".het"))
    (save-buffer)
    (refresh-evalmenu)
    )
  nil
  )

(defun run-eval (spec1)
  (interactive)
;;  (message "selected %s and %s and %s" spec1 spec2 trans)
;; example command
;; matchcad /tmp/flange.het -sMatch -pFlangePattern -dComponent
;  (message (concatenate 'string "asd" (buffer-file-name (current-buffer))))

;  (message "Evaluating EnCL spec")
  (message "Evaluating EnCL spec %s" spec1)
  (let ((buff (prepare-buffer "*Eval-Result*"))
    (fp (buffer-file-name (current-buffer))))

    (message "Evaluating EnCL spec %s" spec1)
    (switch-to-buffer buff)
    (call-process "evalspec" nil buff t "-s" spec1 "-t10" "-v2" fp)
    (insert "\n\nEvaluation of EnCL specification finished.\n")
;;    (start-process-shell-command "evalproc" buff (concatenate 'string "evalspec -s " spec1 " " fp))
    nil)
  )

(defun openspec (filename)
  (interactive "FOpen proof script: ")
  filename)


(defun load-spec ()
  (interactive
     (list (call-interactively 'openspec)
       ))

  (refresh-specmenu)
)