home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / edb / db-lucid.el < prev    next >
Encoding:
Text File  |  1993-06-13  |  8.0 KB  |  246 lines
  1. ;;; db-lucid.el --- part of EDB, the Emacs database
  2.  
  3. ;; See database.el for copyright notice, distribution conditions, etc.
  4.  
  5. ;; Author: Alastair Burt <burt@dfki.uni-kl.de>
  6. ;; Keywords: EDB
  7. ;; Adapted-By: Michael Ernst <mernst@theory.lcs.mit.edu>
  8.  
  9. ;;; Commentary:
  10.  
  11. ;; EDB support for features specific to Lucid GNU Emacs:  fonts, menus, etc.
  12.  
  13. ;; As much of the Lucid support as possible is placed in this file, to
  14. ;; avoid compilation errors and reduce loading time for non-Lucid users.
  15.  
  16. ;; Most of the exported functions contain "lucid" in their name; the idea
  17. ;; is to clue in users who aren't using lucid and get compilation errors
  18. ;; relating to these functions.
  19.  
  20. ;;; Code:
  21.  
  22.  
  23. ;; Ignore this entire file if not running Lucid GNU Emacs.
  24. (if (string-match "Lucid" emacs-version)
  25. (progn
  26.  
  27.  
  28. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29. ;;; Key bindings
  30. ;;;
  31.  
  32. (define-key database-view-mode-map 'button1 'db-lucid-mouse-jump-to-point)
  33. (define-key database-view-mode-map 'button3 'database-view-mode-menu)
  34.  
  35. (define-key database-edit-mode-map 'button1 'db-lucid-mouse-jump-to-point)
  36. (define-key database-edit-mode-map 'button3 'database-edit-mode-menu)
  37.  
  38. ;; (define-key database-summary-mode-map 'button2 'dbs-lucid-mouse-view)
  39. (define-key database-summary-mode-map 'button1 'db-lucid-mouse-jump-to-point)
  40. (define-key database-summary-mode-map 'button3 'database-summary-mode-menu)
  41.  
  42. (defun db-lucid-mouse-jump-to-point (e)
  43.   "Move to the field or record nearest the mouse position.
  44. See `db-jump-to-point' for more details."
  45.   (interactive "@e")            ; @ = select buffer, e = event
  46.   (mouse-track e)            ; set point to where the mouse is
  47.   (db-jump-to-point))
  48.  
  49. (defun dbs-lucid-mouse-view (e)
  50.   "Visit record under mouse in view mode."
  51.   (interactive "@e")
  52.   (mouse-set-point e)
  53.   (db-jump-to-point)
  54.   (dbs-view))
  55.  
  56.  
  57. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  58. ;;; Data display buffer fontification
  59. ;;;
  60.  
  61. (if db-fontification
  62.     ;; Allowing user to set his own preferences in ~/.Xdefaults
  63.     (progn
  64.       (or (find-face 'db-inter-field-face)
  65.        (make-face 'db-inter-field-face))
  66.       (or (face-differs-from-default-p 'db-inter-field-face)
  67.       (copy-face 'bold 'db-inter-field-face))))
  68.  
  69. ;; This is a bit of a hack.  Leaving out the white space stops the field
  70. ;; text from occassionally taking on the 'db-inter-field-face'.  If the
  71. ;; user did not use white space the this would evidently not work.
  72.  
  73. (defun db-fontify (start end)
  74.   "Fontify the region between START and END.  Leave out the leading and
  75.   trailing white space."
  76.   (let (ext-start)
  77.     (save-excursion 
  78.       (goto-char start) 
  79.       (skip-chars-forward " \t\n") 
  80.       (setq ext-start (point))
  81.       (goto-char end)
  82.       (skip-chars-backward " \t\n")
  83.       (if (< ext-start (point))
  84.       (set-extent-face
  85.        (make-extent ext-start (point))
  86.        'db-inter-field-face)))))
  87.  
  88. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  89. ;;; Menus
  90. ;;;
  91.  
  92. ;; quiet the byte-compiler
  93. (defvar zmacs-region-stays)
  94. (defvar database-view-mode-menu)
  95. (defvar database-edit-mode-menu)
  96. (defvar database-summary-mode-menu)
  97. (defvar current-menubar)
  98.  
  99. (defun database-view-mode-menu (e)
  100.   (interactive "@e")
  101.   (setq zmacs-region-stays 't)
  102.   (popup-menu database-view-mode-menu))
  103.  
  104. (defvar database-view-mode-menu
  105.   '("Database-View"
  106.     "VIEW Mode:"
  107.     ("Moving Around"
  108.      ["Next Record" db-next-record t]
  109.      ["Previous Record" db-previous-record t]
  110.      ["First Record" db-first-record t]
  111.      ["Last Record" db-last-record t] 
  112.      ["Jump To Record" db-jump-to-record t]
  113.      ["Next Marked Record" db-next-marked-record t]
  114.      ["Previous Marked Record" db-previous-marked-record t]
  115.      ["Next Record Ignore Omitting" db-next-record-ignore-omitting t]
  116.      ["Previous Record Ignore Omitting" db-previous-record-ignore-omitting t]
  117.      ["Next Screen Or Record" db-next-screen-or-record t]
  118.      ["Previous Screen Or Record" db-previous-screen-or-record t])
  119.     ["Add Record" db-add-record t]
  120.     ["Copy Record" db-copy-record t]
  121.     ["Delete Record" db-delete-record t]
  122.     ["Revert Record" db-revert-record t]
  123.     ["Accept Record" db-accept-record t]
  124.     ["Omit Record" db-omit-record t]
  125.     ["Mark Record" db-mark-record t]
  126.     ["Output Record To Database" db-output-record-to-db t]
  127.     "----"
  128.     ["Create Report" db-report t]
  129.     ["Toggle Omitting" db-omitting-toggle t]
  130.     ["Summary" db-summary t]
  131.     "----"
  132.     ["Edit Mode" db-first-field t]
  133.     "----"
  134.     ["Sort Database" db-sort t]
  135.     ["Revert Database" db-revert-database t]
  136.     ["Write Database To File..." db-write-database-file t]
  137.     ["Save Database" db-save-database t]
  138.     ["Quit" db-quit t]
  139.     ))
  140.  
  141. (defun database-edit-mode-menu (e)
  142.   (interactive "@e")
  143.   (setq zmacs-region-stays 't)
  144.   (popup-menu database-edit-mode-menu))
  145.  
  146. (defvar database-edit-mode-menu
  147.   '("Database-Edit"
  148.     "EDIT Mode:"
  149.     ("Moving Around"
  150.      ["First Field" db-first-field t]
  151.      ["Last Field" db-last-field t]
  152.      ["Next Field" db-next-field t]
  153.      ["Previous Field" db-previous-field t]
  154.      ["Next Record" db-next-record t]
  155.      ["Previous Record" db-previous-record t])
  156.     ["Field Help" db-field-help t]
  157.     ["Revert Field" db-revert-field t]
  158.     ["Search In This Field" db-search-field t]
  159.     "----"
  160.     ["View Mode" db-view-mode t]
  161.     "----"
  162.     ["Revert Database" db-revert-database t]
  163.     ["Write Database To File..." db-write-database-file t]
  164.     ["Save Database" db-save-database t]
  165.     ["Quit" db-quit t]
  166.     ))
  167.  
  168. (defun database-summary-mode-menu (e)
  169.   (interactive "@e")
  170.   (setq zmacs-region-stays 't)
  171.   (popup-menu database-summary-mode-menu))
  172.  
  173. (defvar database-summary-mode-menu
  174.   '("Database-Summary"
  175.     ("Moving Around"
  176.      ["First Record" db-first-record t]
  177.      ["Last Record" db-last-record t]
  178.      ["Jump To Record" db-jump-to-record t]
  179.      ["Next Marked Record" db-next-marked-record t]
  180.      ["Next Record" db-next-record t]
  181.      ["Next Screen Or Record" db-next-screen-or-record t]
  182.      ["Next Record Ignore Omitting" dbs-next-record-ignore-omitting t]
  183.      ["Previous Record Ignore Omitting" dbs-previous-record-ignore-omitting t]
  184.      ["Previous Marked Record" db-previous-marked-record t]
  185.      ["Previous Record" db-previous-record t]
  186.      ["Previous Screen Or Record" db-previous-screen-or-record t]
  187.      ["Isearch Backward" db-isearch-backward t]
  188.      ["Isearch Forward" db-isearch-forward t])
  189.     ["Delete Record" dbs-delete-record t]
  190.     ["Add Record" db-add-record t]
  191.     ["Omit Record" db-omit-record t]
  192.     ["Toggle Use of Omitted Records" db-omitting-toggle t]
  193.     ["Toggle Showing of Omitted Records" db-toggle-show-omitted-records t]
  194.     ["Mark Record" db-mark-record t]
  195.     ["Create Report" db-report t]
  196.     ["Update Summary" db-summary t]
  197.     "----"
  198.     ["View Record" dbs-view t]
  199.     ["Edit Record" dbs-edit t]
  200.     "----"
  201.     ["Sort Database" db-sort t]
  202.     ["Revert Database" db-revert-database t]
  203.     ["Write Database To File..." db-write-database-file t]
  204.     ["Save Database" db-save-database t]
  205.     ["Quit" dbs-exit t]
  206.      ))
  207.  
  208. ;;;
  209. ;;; Button3 menus
  210. ;;;
  211.  
  212. ;; These functions put the mode menus (bound to button3) onto the menubar.
  213. ;; This makes EDB more like VM, GNUS, etc.
  214.  
  215. (defun db-lucid-view-mode-menubar ()
  216.   (if current-menubar
  217.       (if (assoc "DB:View" current-menubar)
  218.       nil
  219.     (if (assoc "DB:Edit" current-menubar)
  220.         (delete-menu-item (list "DB:Edit"))
  221.       (set-buffer-menubar (copy-sequence current-menubar)))
  222.     (add-menu nil "DB:View" 
  223.           (cdr database-view-mode-menu)))))
  224.  
  225. (defun db-lucid-edit-mode-menubar ()
  226.   (if current-menubar
  227.       (if (assoc "DB:Edit" current-menubar)
  228.       nil
  229.     (if (assoc "DB:View" current-menubar)
  230.         (delete-menu-item (list "DB:View"))
  231.       (set-buffer-menubar (copy-sequence current-menubar)))
  232.     (add-menu nil "DB:Edit" 
  233.           (cdr database-edit-mode-menu)))))
  234.  
  235. (defun db-lucid-summary-mode-menubar ()
  236.   (if (and current-menubar 
  237.        (not (assoc "DB:Summary" current-menubar)))
  238.       (progn
  239.     (set-buffer-menubar (copy-sequence current-menubar))
  240.     (add-menu nil "DB:Summary" 
  241.           (cdr database-summary-mode-menu)))))
  242.  
  243. ))    ; end of if (string-match "Lucid" emacs-version)
  244.  
  245. ;;; db-lucid.el ends here
  246.