;;; lisp file for xyzzy ver0.2.2.234
;;; delete-file-recent.l ver.0.1.1.4 // crayonzen [2006-05-11]10:59:36(+0900)

;;;最近閉じたファイルをファイルのメニューに追加します（ダイアログ表示）。
;;;「ツール：共通設定：さまざま：終了時の状態を保存」で開いたままのファイルを閉じた時などに便利。
;;;「最近使ったファイル」（ファイルを開いた履歴）

(provide "delete-file-recent")

(in-package "editor")

(export '(delete-file-list-dialog-box
	  delete-file-list-clear

	  get-exist-directory
	  open-recent-file-dialog

	  *delete-file-name-history*
	  *delete-file-name-list*
	  *delete-file-name-history-max*
	  *delete-opened-file*
	  ))

;;;ヒストリ変数
(define-history-variable *delete-file-name-history* nil)

;;;リスト変数
(defvar *delete-file-name-list* nil)

;;;ヒストリ数（履歴のファイルの数）の最大値
(defvar *delete-file-name-history-max* 100)
;(defvar *delete-file-name-history-max* *minibuffer-maximum-history-count*)

;;;既に開いてるファイルはリストから削除　t：削除　nil：削除しない
(defvar *delete-opened-file* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;フック：ファイルを閉じる時
(add-hook '*delete-buffer-hook* 'add-delete-file-history)

;;;history
;(add-history file '*--*)
;;;list
;(push file *--*)

;;;閉じるファイル（削除ファイル）をリストに加える
(defun add-delete-file-history (filename)
  (if (get-buffer-file-name filename)
      (progn
	(add-history (get-buffer-file-name filename) '*delete-file-name-history*)
	(setq exceed (- (length *delete-file-name-history*) *delete-file-name-history-max*))
	(if (> exceed 0)
	    (setq *delete-file-name-history* (nbutlast *delete-file-name-history* exceed)))
	))
  t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;ファイルを開く
(defun delete-file-list-open-read-file (readfile)
  (let ((filename (cadr readfile))
	(pathname (cadddr readfile))
	(aimopendialog nil))
    (if (file-exist-p pathname)
	(progn
	  (find-file-internal pathname)
	  (set-buffer (find-buffer-string-equal filename))
	  (add-history pathname '*minibuffer-file-name-history*)
	  (message "pathname: ~S" pathname))
      (progn
	;;他のドライブ文字でも検索する
	(setq aimfilelist (get-aimfile-drivecharacterlist pathname))
	(if aimfilelist
	    (progn
	      (push pathname aimfilelist);;×元の選択ファイルを加筆
	      (setq aimopendialog (aimfile-drivecharacterlist-dialog aimfilelist))
	      (if (equalp "cancel" aimopendialog)
		  (return-from delete-file-list-open-read-file nil))))
	;;見つからなければダイアログで選択
	(if (null aimopendialog)
	    (progn
	      (message "pathname: ~S" pathname)
	      (open-recent-file-dialog
	       (concat "開く■ " filename " ■" pathname ) filename t (get-exist-directory pathname)))
	  t)
	)))
  )
;(abbreviate-display-string pathname 80 t)

(defvar drivecharacterlist (list "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"))

(defun get-aimfile-drivecharacterlist (pathname)
  (let ((result nil))
    (if pathname
	(progn
	  (setq strnum (length pathname))
	  (setq str1 (substring pathname 1 strnum))
	  ;;(let* ((strnum (length pathname))
	  ;;(str1 (substring pathname 1 strnum)))
	  (mapcar #'(lambda (item)
		      (setq aimpathname (concat item str1))
		      (if (file-exist-p aimpathname)
			  (push aimpathname result)))
		  drivecharacterlist)
	  )
      ;;)
      )
    result)
  )

(defun aimfile-drivecharacterlist-dialog (aimfilelist)
  (let (dialoglist)
    (if aimfilelist
	(progn
	  (dolist (pathname aimfilelist)
	    (setq filename (file-namestring pathname))
	    (if (file-exist-p pathname)
		(push (list filename "△" pathname) dialoglist)
	      (push (list filename "×" pathname) dialoglist))
	    (setq dialoglist (stable-sort dialoglist #'string< :key #'(lambda (x) (caddr x)))))
	  (multiple-value-bind (result data)
	      (dialog-box `(dialog 0 0 360 173
				   (:caption "ファイルを開く（△開けます：×ありません）")
				   (:font 9 "ＭＳ Ｐゴシック")
				   (:control
				    (:listbox list nil #x50b10111 4 16 292 153)
				    (:button openfile "開く(&O)" #x50030001 305 5 52 14)
				    (:button IDCANCEL "ｷｬﾝｾﾙ" #x50030000 305 22 52 14)))
			  (list (cons 'list dialoglist)
				(cons 'list (nth 0 dialoglist)))
			  '((list :column (32 -4 256) :must-match t :enable (openfile))))
	    (cond ((eq result 'openfile)
		   (let ((readfile (assoc 'list data)))
		     (setq filename (cadr readfile))
		     (setq pathname (cadddr readfile))
		     (if (file-exist-p pathname)
			 (progn
			   (find-file-internal pathname)
			   (set-buffer (find-buffer-string-equal filename))
			   (add-history pathname '*minibuffer-file-name-history*)
			   (message "pathname: ~S" pathname)
			   t)
		       nil)))
		  (t "cancel"))))
      (progn
	nil)))
  )

(defun get-exist-directory (pathname)
  (block getdirectory
    (let* ((aimdirectory pathname))
      (tagbody
	repeat
	(if (or (file-exist-p aimdirectory)
		(<= (length aimdirectory) 3)) ;"C:/"
	    (return-from getdirectory aimdirectory))
	(setq aimdirectory (substring aimdirectory 0 (- (length aimdirectory) 1)))
	(setq aimdirectory (directory-namestring aimdirectory))
	(go repeat)
	)))
  )

(defun open-recent-file-dialog (&optional title filename (multiple t) initialdirectory)
  (interactive)
  (multiple-value-bind (files index encoding eol-code)
      (file-name-dialog :title title
			;;:default (file-namestring filename);;補間パスになる
			:multiple multiple
			:filter *file-dialog-filter*
			:filter-index *file-dialog-filter-index*
			:initial-directory initialdirectory ;○"C:/" ×"C:"
			:char-encoding (or *expected-fileio-encoding* t)
			:eol-code *expected-eol-code*)
    (when files
      (setq *file-dialog-filter-index* index)
      (let ((*expected-fileio-encoding* encoding)
	    (*expected-eol-code* eol-code))
	(declare (special *expected-fileio-encoding* *expected-eol-code*))
	(find-file files))
      (if multiple
	  (dolist (f files t)
	    (add-history f '*minibuffer-file-name-history*))
	(add-history files '*minibuffer-file-name-history*))
      t)))

;;;既に開いてるファイルはリストから削除
(defun delete-opened-file-delete-file-list ()
  (let (newlist
	bufferlist)
    (dolist (item (buffer-list) bufferlist)
      (setq pathname (get-buffer-file-name (buffer-name item)))
      (if pathname
	  (push pathname bufferlist)))
    (dolist (item *delete-file-name-history* newlist)
      (unless (find item bufferlist :test #'equalp)
	(push item newlist)))
    (delete-file-history-clear)
    (dolist (item newlist)
      (add-history item '*delete-file-name-history*))
    )
  )

;;;リストに同じものがあれば削除
(defun delete-same-delete-file-list ()
  (let (newlist)
    (dolist (item *delete-file-name-history* newlist)
      (unless (find item newlist :test #'equalp)
	(push item newlist)))
    (delete-file-history-clear)
    (dolist (item newlist)
      (add-history item '*delete-file-name-history*))
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;ダイアログ用リスト作成

(defvar drivecharacterlist (list "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"))

(defun delete-file-list-make-dialog-list (filenamehistory &optional (sorttype nil))
  (let (result
	bufferlist)
    (if *delete-opened-file*
	(mapcar #'(lambda (pathname)
		    (setq filename (file-namestring pathname))
		    (if (file-exist-p pathname)
			(push (list filename "○" pathname) result)
		      (push (list filename "×" pathname) result))
		    )
		filenamehistory)
      ;;	(dolist (pathname filenamehistory)
      ;;	  (setq filename (file-namestring pathname))
      ;;	  (if (file-exist-p pathname)
      ;;	      (push (list filename "○" pathname) result)
      ;;	    (push (list filename "×" pathname) result))
      ;;	  )
      (progn
	(setq bufferlist (mapcar #'(lambda (buffer)
				     (get-buffer-file-name buffer))
				 (buffer-list)))
	;;	(dolist (item (buffer-list) bufferlist)
	;;	  (setq pathnameb (get-buffer-file-name item))
	;;	  (if pathnameb
	;;	      (push pathnameb bufferlist)))

	(mapcar #'(lambda (pathname)
		    (setq filename (file-namestring pathname))
		    (if (find pathname bufferlist :test #'equalp)
			(push (list filename "●" pathname) result)
		      (if (file-exist-p pathname)
			  (push (list filename "○" pathname) result)
			(push (list filename "×" pathname) result))))
		filenamehistory)

	;;	(dolist (pathname filenamehistory)
	;;	  (setq filename (file-namestring pathname))
	;;	  (if (find pathname bufferlist :test #'equalp)
	;;	      (push (list filename "●" pathname) result)
	;;	    ;;(if (check-valid-pathname pathname);; nil t だけでなくエラーを返してしまうことがる？
	;;	    (if (file-exist-p pathname)
	;;		(push (list filename "○" pathname) result)
	;;	      (push (list filename "×" pathname) result))))
	)
      )

    (if sorttype
	(case sorttype
	  (1 (setq result (stable-sort result #'string< :key #'car))
	     )
	  (2 (setq result (stable-sort result #'string< :key #'(lambda (x) (caddr x))))
	     )
	  (t result))
      (reverse result) ;(nreverse result)
      )

    )
  )

;;;ダイアログ表示
(defvar *list-selected* nil)

(defun delete-file-list-dialog-box (type &optional (sorttype nil))
  (interactive)
  (case type
    (1 (setq dialog-list *minibuffer-file-name-history*)
       (setq dialog-caption "最近使った"))
    (2 (if *delete-opened-file*
	   (delete-opened-file-delete-file-list))
       (delete-same-delete-file-list)
       (setq dialog-list *delete-file-name-history*)
       (setq dialog-caption "最近閉じた"))
    (t (return-from delete-file-list-dialog-box nil)))
  (if *delete-opened-file*
      (setq dialog-caption2 "（○開けます：×ありません）")
    (setq dialog-caption2 "（●開：○開けます：×ありません）"))
  (let ((list (delete-file-list-make-dialog-list dialog-list sorttype)))
    (multiple-value-bind (result data)
	(dialog-box `(dialog 0 0 360 173
			     (:caption ,(concat dialog-caption "ファイルを開く" dialog-caption2))
			     (:font 9 "ＭＳ Ｐゴシック")
			     (:control
			      ;(:listbox list nil #x50a10011 4 16 292 153)
			      (:listbox list nil #x50b10111 4 16 292 153)
			      (:button openfile "開く(&O)" #x50030001 305 5 52 14)
			      (:button IDCANCEL "ｷｬﾝｾﾙ" #x50030000 305 22 52 14)
			      (:button clearlist "ｸﾘｱ(&C)" #x50030000 305 56 52 14)
			      (:button sort1 "ｿｰﾄ(&S)" #x50030000 4 5 52 10)
			      (:button sort2 "ｿｰﾄDir(&D)" #x50030000 116 5 52 10)
			      ))
		    (list (cons 'list list)
			  ;(cons 'list (if (null sorttype) (car list)))
			  ;(cons 'list (find *list-selected* list :test #'equal :key #'caddr))
			  (cons 'list (if (null *list-selected*)
					  (nth 0 list)
					(find *list-selected* list :test #'equal :key #'caddr)))
			  )
		    '((list :column (32 -4 256) :must-match t :enable (openfile sort1 sort2))
		      (clearlist :no-result t)
		      (unregister :no-result t)
		      ;(sort1 :no-result t)
		      ;(sort2 :no-result t)
		      ))
      (cond ((eq result 'openfile)
	     (setq *list-selected* (cadddr (assoc 'list data)))
	     (if (null (delete-file-list-open-read-file (assoc 'list data)))
		 (delete-file-list-dialog-box type sorttype)))
	    ((eq result 'clearlist)
	     (delete-file-list-clear type))
	    ((eq result 'sort1)
	     (setq *list-selected* (cadddr (assoc 'list data)))
	     (delete-file-list-dialog-box type 1))
	    ((eq result 'sort2)
	     (setq *list-selected* (cadddr (assoc 'list data)))
	     (delete-file-list-dialog-box type 2))
	    (t nil);x close window
	    )
      )
    (setq *list-selected* nil);beginning preference
    t)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;リストをクリアー
(defun delete-file-list-clear (type)
  (case type
    (1 (if *minibuffer-file-name-history*
	   (if (yes-or-no-p "リストをクリアーします")
	       (delete-minibuffer-file-name-history-clear)
	     (delete-file-list-dialog-box 1))))
    (2   (if *delete-file-name-history*
	     (if (yes-or-no-p "リストをクリアーします（＊現在開いているファイルは本体終了時に履歴が残ります）")
		 (delete-file-history-clear)
	       (delete-file-list-dialog-box 2))))
    (t (return-from delete-file-list-clear nil)))
  t)

(defun delete-minibuffer-file-name-history-clear ()
  (progn
    (setq *minibuffer-file-name-history* nil)
    (add-file-history-to-menu) ;;refresh menu popup
    (refresh-screen t)
    )
  t)

(defun delete-file-history-clear ()
  (setq *delete-file-name-history* nil)
  t)

#|
スクロールマージン '*scroll-margin* 0 : 0~10000
アンドゥの回数 'kept-undo-information 1000 : 0~
ヒストリの個数 *minibuffer-maximum-history-count* 200 : 0~10000
保存するヒストリの個数 *save-history* 200 : 0~10000
メニューに表示するファイルの履歴 *menu-history-max* 9 : 0~16
|#
