MacFormat 1994 November/macformat-018.iso/Utility Spectacular/Text/Emacs-1.12d folder/lisp/mac/menus.el

Text File | 1993-12-29 | 5.7 KB | 188 lines | [TEXT/EMAC]

;;;
;;; This file is part of a Macintosh port of GNU Emacs.
;;; Copyright (C) 1993 Marc Parmet.  All rights reserved.
;;;
;;; Default menu initialization
;;;
;;; Create the menus.  Menus may already have been inserted by the
;;; .emacs file, so we have to insert these in front of those.  This
;;; is why we insert in reverse order, each one in front of all those
;;; inserted previously.
;;;

;;; This variable can be overridden in .emacs
(defvar fixed-width-fonts '("Courier" "Monaco"))

(defvar font-menu (NewMenu 132 ""))
(mapcar (function (lambda (font-name)
            (AppendMenu font-menu font-name 'do-font)))
    fixed-width-fonts)
(InsertMenu font-menu -1)

(defun check-monaco (fonts i)
  (cond
   ((null fonts)
    0)
   ((string-equal (car fonts) "Monaco")
    (CheckItem font-menu i 1)
    i)
   (t
    (check-monaco (cdr fonts) (1+ i)))))

(defvar last-font-menu-check (check-monaco fixed-width-fonts 1))

(defvar fontsize-menu (NewMenu 133 ""))
(AppendMenu fontsize-menu "9"  'do-font-size)
(AppendMenu fontsize-menu "10" 'do-font-size)
(AppendMenu fontsize-menu "12" 'do-font-size)
(AppendMenu fontsize-menu "14" 'do-font-size)
(AppendMenu fontsize-menu "18" 'do-font-size)
(AppendMenu fontsize-menu "24" 'do-font-size)
(AppendMenu fontsize-menu "(-" nil)
(AppendMenu fontsize-menu "Other..." 'do-font-size-other)
(InsertMenu fontsize-menu -1)
(CheckItem fontsize-menu 1 1)
(defvar last-fontsize-menu-check 1)

(defvar special-menu (NewMenu 131 "Special"))
(AppendMenu special-menu "Show stdout-stderr" 'special-menu-show-stdout)
(AppendMenu special-menu "Change stack size..." 'special-menu-change-stack-size)
(AppendMenu special-menu "Option is meta" 'do-option-is-meta)
(CheckItem special-menu 3 (if option-is-meta 1 0))
(AppendMenu special-menu "(-" nil)
(AppendMenu special-menu "Font/\033" nil)
(AppendMenu special-menu "Font size/\033" nil)
(SetItemMark special-menu 5 132)
(SetItemMark special-menu 6 133)
(InsertMenu special-menu t)

(defvar edit-menu (NewMenu 130 "Edit"))
(AppendMenu edit-menu "Undo/Z" 'do-undo)
(AppendMenu edit-menu "(-" nil)
(AppendMenu edit-menu "Cut/X" 'do-cut)
(AppendMenu edit-menu "Copy/C" 'do-copy)
(AppendMenu edit-menu "Paste/V" 'do-paste)
(AppendMenu edit-menu "Clear" 'do-clear)
(InsertMenu edit-menu t)

(defvar file-menu (NewMenu 129 "File"))
(AppendMenu file-menu "New/N" 'do-new)
(AppendMenu file-menu "Open.../O" 'do-open)
(AppendMenu file-menu "Close/W" 'do-close)
(AppendMenu file-menu "Save/S" 'do-save)
(AppendMenu file-menu "Save as..." 'do-save-as)
(AppendMenu file-menu "(-" nil)
(AppendMenu file-menu "Print buffer/P" 'do-print-buffer)
(AppendMenu file-menu "Print file from disk..." 'do-print-file)
(AppendMenu file-menu "(-" nil)
(AppendMenu file-menu "Kill Emacs" 'file-menu-kill)
(AppendMenu file-menu "Quit/Q" 'do-quit)
(InsertMenu file-menu t)

(defvar apple-menu (NewMenu 128 "\024"))
(AppendMenu apple-menu "About Emacs..." 'apple-menu-about)
(AddResMenu apple-menu "DRVR")
(InsertMenu apple-menu t)
(DrawMenuBar)

;;; Functions to be called in response to the selection of menu items

(defun do-new (menu item)
  (let ((buffer (generate-new-buffer "untitled")))
    (switch-to-buffer buffer)))

(defun do-open (menu item)
  (let ((file-name (GetFile)))
    (if file-name
        (find-file file-name))))

(defun do-close (menu item)
  (if (buffer-modified-p)
      (if (y-or-n-p (concat "Save " (buffer-name) " before closing? "))
      (save-buffer)))
  (kill-buffer (current-buffer)))

(defun do-save (menu item)
  (if (buffer-file-name (current-buffer))
      (save-buffer)
    (do-save-as 0 0)))

(defun do-save-as (menu item)
  (let ((file-name (PutFile "Save file as:" (buffer-name))))
    (if file-name
    (write-file file-name))))

(defun do-print-buffer (menu item)
  (print-buffer))

(defun do-print-file (menu item)
  (let ((file-name (GetFile)))
    (if file-name
    (call-process "lpr" nil 0 nil file-name))))

(defun do-quit (menu item)
  (save-buffers-kill-emacs))

(defun do-undo (menu item)
  (undo)
  (setq last-command 'undo))

(defun do-cut (menu item)
  (save-excursion (copy-region-to-clipboard))
  (kill-region (point) (mark)))

(defun do-copy (menu item)
  (save-excursion (copy-region-to-clipboard))
  (copy-region-as-kill (point) (mark)))

(defun do-paste (menu item)
  (insert-buffer-substring (save-excursion (make-clipboard-current))))

(defun do-clear (menu item)
  (delete-region (point) (mark)))

(defun do-option-is-meta (menu item)
  (setq option-is-meta (not option-is-meta))
  (CheckItem special-menu 3 (if option-is-meta 1 0)))

(defun do-font-size-other-internal (size)
  (interactive "nPoint size: ")
  (if (or (>= size 128) (<= size 0))
      (message "You can't be serious!")
    (special-menu-font-change nil size)))

(defun do-font-size-other (menu item)
  (call-interactively 'do-font-size-other-internal nil)
  (CheckItem fontsize-menu last-fontsize-menu-check 0)
  (setq last-fontsize-menu-check item)
  (CheckItem fontsize-menu item 1))

(defun do-font-size (menu item)
  (let ((s (make-string 256 0)))
    (GetItem fontsize-menu item s)
    (CheckItem fontsize-menu last-fontsize-menu-check 0)
    (setq last-fontsize-menu-check item)
    (CheckItem fontsize-menu item 1)
    (special-menu-font-change nil (string-to-int (PtoCstr s)))))

(defun do-font (menu item)
  (let ((s (make-string 256 0)))
    (GetItem font-menu item s)
    (CheckItem font-menu last-font-menu-check 0)
    (setq last-font-menu-check item)
    (CheckItem font-menu item 1)
    (special-menu-font-change (PtoCstr s) -1)))

(defun do-menu (menu item)
  (let* ((menu-handle (GetMHandle menu))
         (callback (assoc (cons menu-handle item) mac-menu-callback-list)))
    (cond
     (callback
        (funcall (cdr callback) menu-handle item))
     ((= menu-handle apple-menu)
          (let ((s (make-string 256 0)))
            (GetItem apple-menu item s)
            (OpenDeskAcc (PtoCstr s))))
     (t
      nil))))