home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / MENUSPCS.ZIP / MENED.S < prev    next >
Encoding:
Text File  |  1987-12-14  |  3.0 KB  |  87 lines
  1. ;;; ------------------------------------------------------------
  2. ;;; Menus for Scheme (tm)
  3. ;;; AN EXPERIMENTAL MENU-DRIVEN USER INTERFACE FOR PC SCHEME
  4. ;;; EDIT MENU
  5. ;;; $Revision:   1.0  $   $Date:   14 Dec 1987  0:40:08  $
  6. ;;; ------------------------------------------------------------
  7. ;;; Copyright (c) 1987 by Morton Goldberg.  
  8. ;;;
  9. ;;; Permission is granted to make copies of this program text
  10. ;;; for personal, non-commercial use provided this notice of
  11. ;;; copyright appears in all copies and derived works.  All
  12. ;;; other rights reserved.  In particular, you may not publish
  13. ;;; or otherwise distribute any copies of this text or any
  14. ;;; derived works without permission from the copyright holder.
  15. ;;; ------------------------------------------------------------
  16. ;;; Implementation Language: Texas Instruments' PC Scheme
  17. ;;; (Version 3.0)
  18. ;;; ------------------------------------------------------------
  19.  
  20. (writeln "Menu-Driven User Interface -- Edit Menu")
  21. (writeln "Copyright (c) 1987 by Morton Goldberg")
  22. (let ((rev-number "$Revision:   1.0  $"))
  23.   ;; Write the revision number string without the leading
  24.   ;; and trailing dollar-signs (which are needed by the
  25.   ;; version control system).
  26.   (writeln (substring rev-number
  27.                       1
  28.                       (sub1 (string-length rev-number)))))
  29.  
  30. ;;; ------------------------------------------------------------
  31. ;;; EDIT MENU
  32. ;;; ------------------------------------------------------------
  33. ;;; *.S CHOICE
  34.  
  35. ;;; Create a menu of the *.S files in the current directory,
  36. ;;; display it, and call the external editor to edit the file
  37. ;;; selected by the user.
  38. (define (edit-from-menu)
  39.   (define (xedit file-spec)
  40.     (dos-call *external-editor-spec* file-spec 16384))
  41.   (define menu
  42.     (files->menu "*.S"
  43.                  20
  44.                  xedit
  45.                  *vertical-menu-init*))
  46.   (if menu
  47.     (begin
  48.       (h-justify 'CENTER menu)
  49.       (v-justify 'TOP menu)
  50.       (send menu popup)))
  51.   'USER-ABORT)
  52.  
  53. ;;; ------------------------------------------------------------
  54. ;;; Edit ? CHOICE
  55.  
  56. ;;; Activate the file specification popup query window.  Dos-
  57. ;;; call the external editor with the string typed-in by the
  58. ;;; user.
  59. (define (edit-any-file)
  60.   (let ((file-spec
  61.           (get-response-to-query (vector *file-spec-msg* ""))))
  62.     (if file-spec
  63.       (dos-call *external-editor-spec* file-spec 16384)))
  64.   'USER-ABORT)
  65.  
  66. ;;; ------------------------------------------------------------
  67.  
  68. ;;; This is the item list for the edit menu.
  69. (define *edit-menu-items*
  70.   `(("*.S" #\s ,edit-from-menu)
  71.     ("Edit ?" #\e ,edit-any-file)))
  72.  
  73. ;;; Create the edit menu, which is a vertical menu.
  74. (define *edit-menu*
  75.   (let ((menu (make-vertical-menu *vertical-menu-init*
  76.                                   *edit-menu-items*)))
  77.     (h-justify 'CENTER menu)
  78.     (v-justify 'TOP menu)
  79.     menu))
  80.  
  81. ;;; Link to the top-level menu.
  82. (define (edit-menu)
  83.   (send *edit-menu* popup)
  84.   *the-non-printing-object*)
  85.  
  86. ;;; ------------------------------------------------------------
  87.