;; -----------------------------------------------------------------
;; edit-history.el -- Maintain a menu of recently accessed files and
;; buffers.
;;
;; Author: Mic Bowman (mic@transarc.com)
;; -----------------------------------------------------------------
(require 'cl)

(add-hook 'find-file-hooks 'ehistory-add-to-history)
(add-hook 'kill-emacs-hook 'ehistory-save-file-list)
(add-hook 'kill-buffer-hook 'ehistory-kill-buffer)

;; -----------------------------------------------------------------
(defvar ehistory-history-file "~/.emacs_ehistory"
  "File for saving edit history between sessions.")

;; -----------------------------------------------------------------
(defvar ehistory-history-length 20
  "Length of file history.")

;; -----------------------------------------------------------------
(defvar ehistory-file-list nil
  "List of most recently accessed files.")

;; -----------------------------------------------------------------
;  ehistory-add-to-history
;
;  Add a file to the list of recently accessed files.  This function
;  should be called from the find-file-hooks when a file is loaded.
;; -----------------------------------------------------------------
(defun ehistory-add-to-history ()
  (let ((fname (buffer-file-name))
	(hlist ehistory-file-list)
	(hlen  (1- ehistory-history-length)))
    (if (not (string= fname (expand-file-name ehistory-history-file)))
	(progn
	  (setq ehistory-file-list
		(cons fname (ehistory-clean fname hlist hlen)))
	  (ehistory-update-menu-bar)))))

;; -----------------------------------------------------------------
;  ehistory-clean
;
;  Clean the history list. Remove the new file from the list and
;  truncate it to the correct length.
;; -----------------------------------------------------------------
(defun ehistory-clean (fname hlist hlen)
  (cond ((null hlist) nil)
	((= hlen 0) nil)
	((string= fname (car hlist))
	 (ehistory-clean fname (cdr hlist) (1- hlen)))
	((cons (car hlist) (ehistory-clean fname (cdr hlist) (1- hlen))))))

;; -----------------------------------------------------------------
;  ehistory-save-file-list
;
;  Save the file access history list.  This should be added as a hook to
;  kill-emacs-hook.
;; -----------------------------------------------------------------
(defun ehistory-save-file-list ()
  "Save the file access history list."
  (interactive)
  (save-excursion
    (let ((file ehistory-history-file))
      (message (format "Saving edit history to file %s." file))
      (set-buffer (find-file-noselect file))
      (goto-char (point-min))
      (delete-region (point-min) (point-max))
      (print ehistory-file-list (current-buffer))
      (write-file file)
      (kill-buffer (current-buffer)))))

;; -----------------------------------------------------------------
;  ehistory-load-file-list
;
;  Load an edit history file.  This should be called in the startup
;  code.
;; -----------------------------------------------------------------
(defun ehistory-load-file-list ()
  "Load the edit history file specified in the variable ehistory-history-file."
  (interactive)
  (let ((file ehistory-history-file))
    (setq ehistory-file-list nil)
    (if (file-readable-p file)
	(save-excursion
	  (message (format "Loading edit history from %s..." file))
	  (set-buffer (find-file-noselect file))
	  (goto-char (point-min))
	  (setq ehistory-file-list (read (current-buffer)))
	  (kill-buffer (current-buffer)))
      (message (format "Unable to load history from %s..." file)))
    (ehistory-update-menu-bar)))

;; -----------------------------------------------------------------
;  ehistory-files-menu
;
;  Popup a menu of recently edited files.
;; -----------------------------------------------------------------
(defun ehistory-files-menu (flist)
  (if (null flist)
      nil
    (cons
     (nconc (list (car flist) (car flist) (cons nil nil)) 'ehistory-find-file)
     (ehistory-files-menu (cdr flist)))))

;; -----------------------------------------------------------------
;  ehistory-buffers-menu
;
;  A faster and more useful (for me) buffer menu.
;; -----------------------------------------------------------------
(defun ehistory-buffer-menu (blist)
  (cond ((null blist) nil)
	((string-match " *\\*" (buffer-name (car blist)))
	 (ehistory-buffer-menu (cdr blist)))
	((cons
	  (nconc (list (buffer-name (car blist))
		       (buffer-name (car blist))
		       (cons nil nil))
		 'ehistory-select-buffer)
	  (ehistory-buffer-menu (cdr blist))))))

(defun ehistory-current-buffer (buf)
  (equal (buffer-name (current-buffer)) (car buf)))

(defun ehistory-kill-buffer ()
  (let ((menu (remove-if 'ehistory-current-buffer ehistory-last-buffer-list)))
    (setq ehistory-last-buffer-list menu)
    (setq menu (cons 'keymap (cons "Select Buffer" menu)))
    (define-key global-map [menu-bar buffer]
      (cons "Buffers" menu))))

;; -----------------------------------------------------------------
;  ehistory-update-menu-bar
;; -----------------------------------------------------------------
(defvar ehistory-last-buffer-list nil)
(defvar ehistory-last-file-list nil)
(defvar ehistory-update-count 0)

(defun ehistory-update-menu-bar ()
  (let ((bmenu (ehistory-buffer-menu (buffer-list)))
	(fmenu (ehistory-files-menu ehistory-file-list)))
    (setq ehistory-update-count (+ 1 ehistory-update-count))

    (if (not (equal bmenu ehistory-last-buffer-list))
	(progn
	  (setq ehistory-last-buffer-list bmenu)
	  (setq bmenu (cons 'keymap (cons "Select Buffer" bmenu)))
	  (define-key global-map [menu-bar buffer]
	    (cons "Buffers" bmenu))))

    (if (not (equal fmenu ehistory-last-file-list))
	(progn
	  (setq ehistory-last-file-list fmenu)
	  (setq fmenu (cons 'keymap (cons "Select File" fmenu)))
	  (define-key global-map [menu-bar history]
	    (cons "History" fmenu))))))

;; -----------------------------------------------------------------
(defun ehistory-find-file ()
  (interactive)
  (find-file last-command-event))

(defun ehistory-select-buffer ()
  (interactive)
  (switch-to-buffer last-command-event))

;; -----------------------------------------------------------------
(if (member 'menu-bar-update-buffers menu-bar-update-hook)
    (remove-hook 'menu-bar-update-hook 'menu-bar-update-buffers))