;;; db-lucid.el --- part of EDB, the Emacs database

;; See database.el for copyright notice, distribution conditions, etc.

;; Author: Alastair Burt <burt@dfki.uni-kl.de>
;; Keywords: EDB
;; Adapted-By: Michael Ernst <mernst@theory.lcs.mit.edu>

;;; Commentary:

;; EDB support for features specific to Lucid GNU Emacs:  fonts, menus, etc.

;; As much of the Lucid support as possible is placed in this file, to
;; avoid compilation errors and reduce loading time for non-Lucid users.

;; Most of the exported functions contain "lucid" in their name; the idea
;; is to clue in users who aren't using lucid and get compilation errors
;; relating to these functions.

;;; Code:


;; Ignore this entire file if not running Lucid GNU Emacs.
(if (string-match "Lucid" emacs-version)
(progn


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Key bindings
;;;

(define-key database-view-mode-map 'button1 'db-lucid-mouse-jump-to-point)
(define-key database-view-mode-map 'button3 'database-view-mode-menu)

(define-key database-edit-mode-map 'button1 'db-lucid-mouse-jump-to-point)
(define-key database-edit-mode-map 'button3 'database-edit-mode-menu)

(define-key database-summary-mode-map 'button1 'db-lucid-mouse-jump-to-point)
(define-key database-summary-mode-map 'button2 'dbs-lucid-mouse-view)
(define-key database-summary-mode-map 'button3 'database-summary-mode-menu)

(defun db-lucid-mouse-jump-to-point (e)
  "Move to the field or record nearest the mouse position.
See `db-jump-to-point' for more details."
  (interactive "@e")			; @ = select buffer, e = event
  (mouse-track e)			; set point to where the mouse is
  (db-jump-to-point))

(defun dbs-lucid-mouse-view (e)
  "Visit record under mouse in view mode."
  (interactive "@e")
  (mouse-set-point e)
  (db-jump-to-point)
  (dbs-view))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Data display buffer fontification
;;;

(if db-fontification
    ;; Allowing user to set his own preferences in ~/.Xdefaults
    (progn
      (or (find-face 'db-inter-field-face)
 	  (make-face 'db-inter-field-face))
      (or (face-differs-from-default-p 'db-inter-field-face)
	  (copy-face 'bold 'db-inter-field-face))))

;; This is a bit of a hack.  Leaving out the white space stops the field
;; text from occassionally taking on the 'db-inter-field-face'.  If the
;; user did not use white space the this would evidently not work.

(defun db-fontify (start end)
  "Fontify the region between START and END.  Leave out the leading and
  trailing white space."
  (let (ext-start)
    (save-excursion 
      (goto-char start) 
      (skip-chars-forward " \t\n") 
      (setq ext-start (point))
      (goto-char end)
      (skip-chars-backward " \t\n")
      (if (< ext-start (point))
	  (set-extent-face
	   (make-extent ext-start (point))
	   'db-inter-field-face)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Menus
;;;

;; quiet the byte-compiler
(defvar zmacs-region-stays)
(defvar database-view-mode-menu)
(defvar database-edit-mode-menu)
(defvar database-summary-mode-menu)
(defvar current-menubar)

(defun database-view-mode-menu (e)
  (interactive "@e")
  (setq zmacs-region-stays 't)
  (popup-menu database-view-mode-menu))

(defvar database-view-mode-menu
  '("Database-View"
    "VIEW Mode:"
    ("Moving Around"
     ["Next Record" db-next-record t]
     ["Previous Record" db-previous-record t]
     ["First Record" db-first-record t]
     ["Last Record" db-last-record t] 
     ["Jump To Record" db-jump-to-record t]
     ["Next Marked Record" db-next-marked-record t]
     ["Previous Marked Record" db-previous-marked-record t]
     ["Next Record Ignore Omitting" db-next-record-ignore-omitting t]
     ["Previous Record Ignore Omitting" db-previous-record-ignore-omitting t]
     ["Next Screen Or Record" db-next-screen-or-record t]
     ["Previous Screen Or Record" db-previous-screen-or-record t])
    ["Add Record" db-add-record t]
    ["Copy Record" db-copy-record t]
    ["Delete Record" db-delete-record t]
    ["Revert Record" db-revert-record t]
    ["Accept Record" db-accept-record t]
    ["Omit Record" db-omit-record t]
    ["Mark Record" db-mark-record t]
    ["Output Record To Database" db-output-record-to-db t]
    "----"
    ["Create Report" db-report t]
    ["Toggle Omitting" db-omitting-toggle t]
    ["Summary" db-summary t]
    "----"
    ["Edit Mode" db-first-field t]
    "----"
    ["Sort Database" db-sort t]
    ["Revert Database" db-revert-database t]
    ["Write Database To File..." db-write-database-file t]
    ["Save Database" db-save-database t]
    ["Quit" db-quit t]
    ))

(defun database-edit-mode-menu (e)
  (interactive "@e")
  (setq zmacs-region-stays 't)
  (popup-menu database-edit-mode-menu))

(defvar database-edit-mode-menu
  '("Database-Edit"
    "EDIT Mode:"
    ("Moving Around"
     ["First Field" db-first-field t]
     ["Last Field" db-last-field t]
     ["Next Field" db-next-field t]
     ["Previous Field" db-previous-field t]
     ["Next Record" db-next-record t]
     ["Previous Record" db-previous-record t])
    ["Field Help" db-field-help t]
    ["Revert Field" db-revert-field t]
    ["Search In This Field" db-search-field t]
    "----"
    ["View Mode" db-view-mode t]
    "----"
    ["Revert Database" db-revert-database t]
    ["Write Database To File..." db-write-database-file t]
    ["Save Database" db-save-database t]
    ["Quit" db-quit t]
    ))

(defun database-summary-mode-menu (e)
  (interactive "@e")
  (setq zmacs-region-stays 't)
  (popup-menu database-summary-mode-menu))

(defvar database-summary-mode-menu
  '("Database-Summary"
    ("Moving Around"
     ["First Record" db-first-record t]
     ["Last Record" db-last-record t]
     ["Jump To Record" db-jump-to-record t]
     ["Next Marked Record" db-next-marked-record t]
     ["Next Record" db-next-record t]
     ["Next Screen Or Record" db-next-screen-or-record t]
     ["Next Record Ignore Omitting" dbs-next-record-ignore-omitting t]
     ["Previous Record Ignore Omitting" dbs-previous-record-ignore-omitting t]
     ["Previous Marked Record" db-previous-marked-record t]
     ["Previous Record" db-previous-record t]
     ["Previous Screen Or Record" db-previous-screen-or-record t]
     ["Isearch Backward" db-isearch-backward t]
     ["Isearch Forward" db-isearch-forward t])
    ["Delete Record" dbs-delete-record t]
    ["Add Record" db-add-record t]
    ["Omit Record" db-omit-record t]
    ["Toggle Use of Omitted Records" db-omitting-toggle t]
    ["Toggle Showing of Omitted Records" db-toggle-show-omitted-records t]
    ["Mark Record" db-mark-record t]
    ["Create Report" db-report t]
    ["Update Summary" db-summary t]
    "----"
    ["View Record" dbs-view t]
    ["Edit Record" dbs-edit t]
    "----"
    ["Sort Database" db-sort t]
    ["Revert Database" db-revert-database t]
    ["Write Database To File..." db-write-database-file t]
    ["Save Database" db-save-database t]
    ["Quit" dbs-exit t]
     ))

;;;
;;; Button3 menus
;;;

;; These functions put the mode menus (bound to button3) onto the menubar.
;; This makes EDB more like VM, GNUS, etc.

(defun db-lucid-view-mode-menubar ()
  (if current-menubar
      (if (assoc "DB:View" current-menubar)
	  nil
	(if (assoc "DB:Edit" current-menubar)
	    (delete-menu-item (list "DB:Edit"))
	  (set-buffer-menubar (copy-sequence current-menubar)))
	(add-menu nil "DB:View" 
		  (cdr database-view-mode-menu)))))

(defun db-lucid-edit-mode-menubar ()
  (if current-menubar
      (if (assoc "DB:Edit" current-menubar)
	  nil
	(if (assoc "DB:View" current-menubar)
	    (delete-menu-item (list "DB:View"))
	  (set-buffer-menubar (copy-sequence current-menubar)))
	(add-menu nil "DB:Edit" 
		  (cdr database-edit-mode-menu)))))

(defun db-lucid-summary-mode-menubar ()
  (if (and current-menubar 
	   (not (assoc "DB:Summary" current-menubar)))
      (progn
	(set-buffer-menubar (copy-sequence current-menubar))
	(add-menu nil "DB:Summary" 
		  (cdr database-summary-mode-menu)))))

))	; end of if (string-match "Lucid" emacs-version)

;;; db-lucid.el ends here