;;; lisp file for xyzzy ver0.2.2.234
;;; lisp-tool.l ver0.0.0.8 // crayonzen [2022-02-07]12:45:07(+0900)

(provide "lisp-tool")

(in-package "editor")

(export '(
	  ;byte-compile-selected-buffer
	  comment-out-region-selection
	  delete-comment-out-region-selection
	  indent-region-selection
	  indent-region-all
	  *lisp-tool-menus*
	  init-lisp-tool-menu
	  ;*lisp-tool-view-menu*
	  lisp-tool-view
	  ))

;;(defun byte-compile-selected-buffer ()
;;  (interactive)
;;  (if (setq filename (get-buffer-file-name))
;;      (long-operation
;;	(compile-file filename))
;;    (msgbox "~Aはコンパイルできません" (buffer-name (selected-buffer)))))

;;lisp用コメントアウト
(defun comment-out-region-selection ()
  (interactive "*")
  (save-excursion
    (cond ((pre-selection-p)
	   (setq from (selection-mark) to (selection-point))
	   (setq lfd t))
	  ((mark t)
	   (setq from (mark) to (point))
	   (setq lfd t))
	  (t
	   (setq from (point) to (progn (goto-eol) (point)))
	   (setq lfd nil))
	  )
    (if (> from to)
	(rotatef from to))

    (setq end (progn (goto-char to) (eolp)))
    (if (and (eolp)
	     (eq from to))
	(insert #\; 2)
      (save-restriction
	(goto-char from)
	(narrow-to-region from to)
	(goto-char (point-min))
	;;(skip-chars-forward " \t\n")
	(insert #\; 2)
	(while (forward-line 1)
	  ;;(skip-chars-forward " \t\n")
	  (insert #\; 2)
	  )
	(if (and lfd
		 (null end))
	    (progn
	      (goto-char (point-max))
	      (insert #\LFD 1)))
	)))
  )

;;lisp用コメントアウトを削除
(defun delete-comment-out-region-selection ()
  (interactive "*")
  (save-excursion
    (cond ((pre-selection-p)
	   (setq from (selection-mark) to (selection-point)))
	  ((mark t)
	   (setq from (mark) to (point)))
	  (t
	   (setq from (point) to (progn (goto-eol) (point))))
	  )
    (if (> from to)
	(rotatef from to))

    (goto-char to)
    (if (and (eolp)
	     (eq from to))
	(return-from delete-comment-out-region-selection nil)
      (save-restriction
	(goto-char from)
	(narrow-to-region from to)
	(goto-char (point-min))
	(while (scan-buffer "\;":regexp t)
	  (if (null (char= (preceding-char) #\\))
	      (delete-char 1)
	    (if (null (forward-char 1))
		(return)))
	  ))))
  )

(defun indent-region-selection ()
  (interactive "*")
  (if (pre-selection-p)
      (indent-region (selection-mark) (selection-point))
    (indent-region (mark nil) (point))
    ))

(defun indent-region-all ()
  (interactive "*")
  (indent-region (point-min) (point-max)))

;;;メニュー
(defvar *lisp-tool-menus* nil)

(defun init-lisp-tool-menu ()
  (or *lisp-tool-menus*
      (setq *lisp-tool-menus* (create-popup-menu)))

  (setq *lisp-tool-menus*
	(define-popup-menu
	  (:item :tag-command "ｲﾝﾃﾞﾝﾄ〜ﾘｰｼﾞｮﾝ:indent-region-selection(&Ｉ)"
	   'indent-region-selection)
	  (:item :tag-command "ｲﾝﾃﾞﾝﾄ〜全範囲(&J)"
	   'indent-region-all)
	  :sep
	  (:item :tag-command "コメントアウト(&O)"
	   'comment-out-region-selection)
	  (:item :tag-command "コメントアウト削除(&D)"
	   'delete-comment-out-region-selection)
	  :sep
	  (:item nil "Lisp関数の評価"
	   'nil)
	  (:item nil "バッファー全体を評価:eval-buffer(&B)"
	   #'(lambda () (interactive)
	       (eval-buffer (selected-buffer))))
	  (:item :tag-command "括弧の式を評価：eval-last-sexp(&L)"
	   'eval-last-sexp)
	  (:item :tag-command "括弧の式を評価：結果はその場に:eval-print-last-sexp(&L)"
	   'eval-print-last-sexp)
	  (:item :tag-command "カーソルとマークの間〜関数名を補完:eval-region(&R)"
	   'eval-region)
	  (:item :tag-command "ミニバッファの式を評価:eval-expression(&E)"
	   'eval-expression)
	  :sep
	  (:item :tag-command "バッファ中の関数の一覧:list-function"
	   'list-function)
	  (:item :tag-command "コマンドを得る〜Enter全てまたはkey指定:command-apropos"
	   'command-apropos)
	  (:item :tag-command "全てのシンボルLisp関数の一覧:lisp-complete-symbol"
	   'lisp-complete-symbol)
	  :sep
	  (:item :tag-command "バイトコンパイル：選択バッファ"
	   'byte-compile-selected-buffer)
	  (:item :tag-command "バイトコンパイル"
	   'byte-compile-file)
	  ;;use compile-directory.l
	  (:item :tag-command "バイトコンパイルディレクトリ：全て尋ねる"
	   'byte-compile-directory-ask)
	  (:item :tag-command "バイトコンパイルディレクトリ：新のみ"
	   'byte-compile-directory)
	  (:item :tag-command "バイトコンパイルディレクトリ：全て"
	   'byte-compile-directory-all)
	  )
	)
  )

;;;;;;;;;;;;;;;;Add Menu
(add-hook '*init-app-menus-hook*
		  #'(lambda ()
			  (if (init-lisp-tool-menu)
				  (if (setq ip (get-menu-position *app-menu* 'ed::help))
					  (insert-popup-menu *app-menu* ip *lisp-tool-menus* "Lisp(&L)")
					(add-popup-menu *app-menu* *lisp-tool-menus* "Lisp(&L)")
					)
				)
			  ))

#|

;;;;;;;;;;;;;;;;menu view ＆ hide ＞ app-menu.l 表示メニューなどに記述してセットする
(defvar *lisp-tool-view-menu* nil)

(defun lisp-tool-view ()
  (interactive)
  (multiple-value-setq (ip menu)
    (get-menu-position *app-menu* 'ed::help))
  (if *lisp-tool-view-menu*
      (progn
	(delete-menu *app-menu* (decf ip) t)
	(setq *lisp-tool-view-menu* nil)
	)
    (progn
      (init-lisp-tool-menu)
      (setq *lisp-tool-view-menu*
	    (insert-popup-menu *app-menu* ip
			       *lisp-tool-menus* "Lisp(&L)"))))
  )
|#

#|
(add-hook '*init-app-menus-hook*
	  #'(lambda ()
	      (when (and *app-menu*
			 (setq menu (get-menu *app-menu* 'ed::view)))
		(add-menu-separator menu 'lisp-tool-view-sep)
		(add-menu-item menu 'lisp-tool-view-tag "LispTool(&L)"
			       'lisp-tool-view
			       #'(lambda () (when *lisp-tool-view-menu* :check))))))
|#

#|
;;;;;;;;;;;;;;;; 追加メニュー　add menu lisp（メニューの最後に追加）
(add-hook '*init-app-menus-hook*
	  #'(lambda ()
	      (init-lisp-tool-menu)
	      (add-popup-menu *app-menu* *lisp-tool-menus* "Lisp(&L)")
	      ))
|#
