home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / energize / energize-init.el < prev    next >
Encoding:
Text File  |  1993-03-25  |  18.2 KB  |  514 lines
  1. ;;; -*- Mode:Emacs-Lisp -*-
  2. ;;; Copyright ⌐ 1990-1993 by Lucid, Inc.  All Rights Reserved.
  3.  
  4. (defvar energize-auto-raise-screen t
  5.   "If T screens are automatically raised when Energize wants to show them.")
  6.  
  7. (defvar energize-connect-hook nil
  8.   "*Function or functions to run when the Energize connection is established.")
  9.  
  10. (defvar energize-disconnect-hook nil
  11.  "*Function or functions to run when the Emacs/Energize connection is closed.")
  12.  
  13.  
  14. (defvar energize-screen-mode nil)
  15. (defvar energize-split-screens-p t)
  16.  
  17. (defun energize-multi-screen-mode ()
  18.   "Call this function to put Energize into multi-screen mode.
  19.  
  20. A screen named \"debugger\" will be used for the *Debugger* buffer,
  21.   and its associated source files.
  22. A screen named \"energize\" will be used for the Top-Level buffer.
  23. A screen named \"browser\" will be created for each L.E. Browser buffer.
  24.  At most 5 of these will be created; then they will be reused.
  25. A screen named \"project\" will be created for each Project buffer.
  26. A screen named \"error-log\" will be created for the Error Log buffer
  27.  and its associated source files (as when the Next Error command 
  28.  displays a source file.)
  29. A screen named \"manual\" will be created for each UNIX Manual page.
  30.  At most 5 of these will be created; then they will be reused.
  31.  
  32. If an external editor is being used, then source files will be displayed
  33. read-only in the \"debugger\" screen.
  34.  
  35. If an external editor is not being used, then screens named \"sources\" 
  36. will be created to edit source files.  At most five of these will be 
  37. created; then they will be reused.  Find-file will use the current screen,
  38. whatever that happens to be, but find-file-other-window, and selecting 
  39. source files from the Buffers menu will use an existing screen displaying
  40. the file in question, or create a new one if there isn't one.
  41.  
  42. Call `energize-single-screen-mode' to turn this off.
  43.  
  44. See the documentation for the function get-screen-for-buffer for 
  45. information on how to customize this."
  46.   (interactive)
  47.   (put 'project      'instance-limit 0)
  48.   (put 'sources      'instance-limit 5)
  49.   (put 'manual       'instance-limit 5)
  50.   (put 'browser      'instance-limit 5)
  51.   (put 'energize-debugger-mode        'screen-name 'debugger)
  52.   (put 'gdb-mode              'screen-name 'debugger)
  53.   (put 'energize-top-level-mode       'screen-name 'energize)
  54.   (put 'energize-browser-mode         'screen-name 'browser)
  55.   (put 'energize-breakpoint-mode      'screen-name 'browser)
  56.   (put 'energize-project-mode         'screen-name 'project)
  57.   (put 'energize-no-file-project-mode 'screen-name 'project)
  58.   (put 'energize-log-mode             'screen-name 'error-log)
  59.   (put 'energize-manual-entry-mode    'screen-name 'manual)
  60.   (if energize-external-editor
  61.       (setq get-screen-for-buffer-default-screen-name 'debugger)
  62.     ;; hmmmm...
  63.     (setq get-screen-for-buffer-default-screen-name 'sources))
  64.   (setq buffers-menu-switch-to-buffer-function 'pop-to-buffer)
  65.   (setq energize-screen-mode 'multi)
  66.   t)
  67.  
  68. (defun energize-several-screens-mode ()
  69.   "Call this function to put Energize into multi-screen mode, 
  70. but with only a few screens.  See also `energize-multi-screen-mode'.
  71.  
  72. A screen named \"debugger\" will be used for the *Debugger* buffer,
  73.   and its associated source files.
  74. A screen named \"energize\" will be used for the Top-Level buffer.
  75. A single screen named \"browser\" will be created for L.E. Browser buffers.
  76. A single screen named \"project\" will be created for Project buffers.
  77. A screen named \"error-log\" will be created for the Error Log buffer
  78.  and its associated source files (as when the Next Error command 
  79.  displays a source file.)
  80. A single screen named \"manual\" will be created for UNIX Manual page buffers.
  81.  
  82. If an external editor is being used, then source files will be displayed
  83. read-only in the \"debugger\" screen.
  84.  
  85. If an external editor is not being used, then a single screen named 
  86. \"sources\" will be created to edit source files.  Find-file will use the
  87. current screen, whatever that happens to be, but find-file-other-window, 
  88. and selecting source files from the Buffers menu will use an existing screen
  89. displaying the file in question, or create a new one if there isn't one.
  90.  
  91. Call `energize-single-screen-mode' to turn this off.
  92.  
  93. See the documentation for the function get-screen-for-buffer for 
  94. information on how to customize this."
  95.   (interactive)
  96.   (energize-multi-screen-mode)
  97.   (remprop 'browser 'instance-limit)
  98.   (remprop 'project 'instance-limit)
  99.   (remprop 'manual  'instance-limit)
  100.   (remprop 'sources 'instance-limit)
  101.   (setq energize-screen-mode 'several)
  102.   t)
  103.  
  104. (defun energize-single-screen-mode ()
  105.   "Call this function to put Energize into single-screen mode.
  106. All buffers will be displayed in the currently selected screen."
  107.   (interactive)
  108.   (remprop 'browser 'instance-limit)
  109.   (remprop 'project 'instance-limit)
  110.   (remprop 'manual  'instance-limit)
  111.   (remprop 'sources 'instance-limit)
  112.   (remprop 'energize-debugger-mode        'screen-name)
  113.   (remprop 'gdb-mode                  'screen-name)
  114.   (remprop 'energize-top-level-mode       'screen-name)
  115.   (remprop 'energize-browser-mode         'screen-name)
  116.   (remprop 'energize-breakpoint-mode      'screen-name)
  117.   (remprop 'energize-project-mode         'screen-name)
  118.   (remprop 'energize-no-file-project-mode 'screen-name)
  119.   (remprop 'energize-log-mode             'screen-name)
  120.   (remprop 'energize-manual-entry-mode    'screen-name)
  121.   (setq get-screen-for-buffer-default-screen-name nil)
  122.   (setq buffers-menu-switch-to-buffer-function 'switch-to-buffer)
  123.   (setq energize-screen-mode 'single)
  124.   nil)
  125.  
  126. (energize-single-screen-mode)
  127.  
  128.  
  129. ;;; Connecting and disconnecting
  130.  
  131. (or energize-attributes-mapping 
  132.     (setq energize-attributes-mapping
  133.       '((1 bold)
  134.         (2 italic)
  135.         (3 bold-italic)
  136.         (4 attributeSmall)
  137.         (50 attributeGlyph)
  138.         (51 attributeSectionHeader)
  139.         (52 attributeToplevelFormGlyph)
  140.         (53 attributeModifiedToplevelFormGlyph)
  141.         (54 attributeBrowserHeader)
  142.         (68 attributeWriteProtected)
  143.         (69 attributeModifiedText)
  144.         )))
  145.  
  146. (defun energize-initialize-faces ()
  147.   (setq energize-attributes-mapping
  148.     (mapcar (function (lambda (l)
  149.                 (cons (car l)
  150.                   (cons (car (cdr l))
  151.                     (face-id
  152.                      (or (find-face (car (cdr l)))
  153.                          (make-face (car (cdr l)))))))))
  154.         energize-attributes-mapping)))
  155.  
  156. (defun any-energize-buffers-p ()
  157.   (let ((rest (buffer-list))
  158.     (result nil))
  159.     (while rest
  160.       (if (energize-buffer-p (car rest))
  161.       (setq result (car rest) rest nil)
  162.     (setq rest (cdr rest))))
  163.     result))
  164.  
  165. (defun connect-to-energize (server &optional enarg)
  166.   "Connect this emacs to a Energize server.
  167. The SERVER argument should be the name of the host that the kernel is
  168. running on (empty-string for localhost).  It may also be of the form
  169. ``hostname:user'' or ``:user'', meaning to use the server running with
  170. userid USER."
  171.   (interactive (if (connected-to-energize-p)
  172.            (error "Already connected to the server.") ; you bogon.
  173.          (list (read-string "connect to energize server: "))))
  174.   (if (connected-to-energize-p)
  175.       (error "Already connected to the server.")) ; you bogon.
  176.   (if (or (null server) (equal server ""))
  177.       (setq server (system-name)))
  178.   (setq default-screen-name "energize")
  179.   (energize-rename-things)
  180.   (energize-hack-external-editor-mode)
  181.  
  182.   (let ((energize-disconnect-hook
  183.      ;; If we're being run interactively, don't exit emacs if connecting
  184.      ;; to Energize fails!  That's damn annoying.
  185.      (if (and (interactive-p)
  186.           (consp energize-disconnect-hook)
  187.           (memq 'save-buffers-kill-emacs energize-disconnect-hook))
  188.          (delq 'save-buffers-kill-emacs
  189.            (copy-sequence energize-disconnect-hook))
  190.        energize-disconnect-hook)))
  191.  
  192.     (connect-to-energize-internal server enarg)
  193.     (energize-initialize-faces)
  194.     ;; Wait for the Top-Level buffer to be created.
  195.     ;; This really should happen down in C, but...
  196.     (let ((p (or (get-process "energize")
  197.          (error "Could not connect to Energize.")))
  198.       b)
  199.       (while (progn
  200.            (or (connected-to-energize-p)
  201.            (error "Energize connection refused."))
  202.            (not (setq b (any-energize-buffers-p))))
  203.     (accept-process-output p))
  204.       ;; Make the displayed Energize buffer initially displayed.
  205.       (pop-to-buffer b)
  206.       (delete-other-windows)
  207.       (run-hooks 'energize-connect-hook))))
  208.  
  209. (defun disconnect-from-energize ()
  210.   (interactive)
  211.   "Close the connection to energize"
  212.   (close-connection-to-energize))
  213.  
  214. ;;; Energizing all buffers
  215. ;; After being connected to energize this function energizes all the
  216. ;; buffers that contain files that Energize knows about.
  217.  
  218. (defun energize-all-buffers ()
  219.   "Energize any buffer showing a file that the Energize server knows about.
  220. Has to be called after Emacs has been connected to Energize"
  221.   (if (not (connected-to-energize-p))
  222.       (error "You have to connect to Energize first"))
  223.   (save-window-excursion
  224.    (save-excursion
  225.     (let ((buffers (buffer-list))
  226.       (buffers-to-avoid '())
  227.       (lock-directory nil)
  228.       buffer
  229.       filename)
  230.       (while buffers
  231.     (setq buffer (car buffers))
  232.     (setq buffers (cdr buffers))
  233.     (setq filename (buffer-file-name buffer))
  234.     (set-buffer buffer)
  235.     (cond
  236.      ((and filename
  237.            (not (energize-buffer-p buffer))
  238.            (energize-query-buffer filename t))
  239.       (cond ((buffer-modified-p)
  240.          (if (y-or-n-p
  241.               (format
  242.                "Buffer %s must be saved to be Energized; save it? "
  243.                (buffer-name buffer)))
  244.              (progn
  245.                (set-buffer buffer) ; oh, man...
  246.                (save-buffer))
  247.            ;; said "no"
  248.            (setq buffers-to-avoid (cons buffer buffers-to-avoid))))
  249.         
  250.         ((and (null (verify-visited-file-modtime buffer))
  251.               (file-exists-p filename))
  252.          (set-buffer buffer)
  253.          (if (y-or-n-p
  254.               (format "Buffer %s has changed on disk, revert? "
  255.                   (buffer-name buffer)))
  256.              (progn
  257.                (set-buffer buffer)
  258.                (revert-buffer nil t))
  259.            ;; said "no"
  260.            (setq buffers-to-avoid (cons buffer buffers-to-avoid))))
  261.  
  262.         ;; It's wrong to check to also see if someone else is locking
  263.         ;; the file.  The file is already in the buffer, and the user
  264.         ;; isn't really modifying it -- we're just rewriting it because
  265.         ;; energize likes to do that.  That's why locking should be
  266.         ;; disabled here.
  267.         )
  268.       (if (not (memq buffer buffers-to-avoid))
  269.           (find-file-noselect filename)
  270.         (message (format "Buffer %s not Energized." (buffer-name buffer)))
  271.         (sit-for 1)))))))))
  272.  
  273. (add-hook 'energize-connect-hook 'energize-all-buffers)
  274.  
  275.  
  276. ;; This is called when the connection to Energize is lose (for whatever reason).
  277. ;; We could just run the energize-disconnect-hook from C and put this function
  278. ;; on it, but then the user could hurt themselves.
  279. ;;
  280. (defun de-energize-all-buffers ()
  281.   (save-excursion
  282.     (let ((buffers (buffer-list))
  283.       buffer)
  284.       (while buffers
  285.     (condition-case condition
  286.         (progn
  287.           (setq buffer (car buffers))
  288.           (set-buffer buffer)
  289.           (cond ((not (energize-buffer-p buffer))
  290.              nil)
  291.             ((eq (energize-buffer-type buffer) 'energize-source-buffer)
  292.              (map-extents
  293.               (function (lambda (extent ignore)
  294.                   (if (eq 'energize-extent-data
  295.                       (car-safe (extent-data extent)))
  296.                       (delete-extent extent))
  297.                   nil))
  298.               buffer)
  299.              (remove-hook 'write-file-data-hooks
  300.                   'energize-write-data-hook)
  301.              (setq revert-buffer-insert-file-contents-function nil)
  302.              (energize-orig-normal-mode))
  303.             (t ; non-source-file Energize buffers
  304.              (set-buffer-modified-p nil)
  305.              (if (eq (other-buffer buffer) buffer)
  306.              (set-buffer (get-buffer-create "*scratch*"))
  307.                (set-buffer (other-buffer buffer)))
  308.              (kill-buffer buffer))))
  309.       (error ;; condition-case clause
  310.        (beep)
  311.        (message "Error while de-Energizing: %s" condition)))
  312.     (setq buffers (cdr buffers)))))
  313.   ;; now clean the menubar
  314.   (deactivate-all-energize-menu-items)
  315.   (energize-rename-things 'back)
  316.   (run-hooks 'energize-disconnect-hook)
  317.   nil)
  318.  
  319.  
  320. (defun energize-rename-things (&optional back)
  321.   ;; People who don't like emacs don't like seeing the word "Emacs" either
  322.   (let ((case-fold-search t))
  323.     (if (and (consp mode-line-buffer-identification)
  324.          (stringp (car mode-line-buffer-identification))
  325.          (string-match (if back "\\bEnergize\\b"
  326.                  "\\bL?Emacs\\([- \t]*[-._0-9]+\\)?\\b")
  327.                (car mode-line-buffer-identification)))
  328.     (setq-default mode-line-buffer-identification
  329.               (cons
  330.                (concat (substring (car mode-line-buffer-identification)
  331.                       0 (match-beginning 0))
  332.                    (if back "Emacs" "Energize")
  333.                    (substring (car mode-line-buffer-identification)
  334.                       (match-end 0)))
  335.                (cdr mode-line-buffer-identification))))
  336. ;    (if (stringp screen-title-format)
  337. ;    (if back
  338. ;        (if (string-match "^Energize\\b ?" screen-title-format)
  339. ;        (setq-default screen-title-format "%S: %b"))
  340. ;      (or (string-match "Energize" screen-title-format)
  341. ;          (setq-default screen-title-format "Energize: %b"))))
  342.     )
  343.   nil)
  344.  
  345.  
  346.  
  347. ;;; The kernel is very random about the buffer-types it returns.
  348. ;;; This is a temporary permanent fix...
  349.  
  350. (defun energize-buffer-type (buffer)
  351.   "Returns a symbol denoting the type of an Energize buffer, or nil."
  352.   (let ((type (energize-buffer-type-internal buffer)))
  353.     (cond ((eq type 'energize-top-level-buffer)
  354.        (cond ((equal "Error Log" (buffer-name buffer))
  355.           'energize-error-log-buffer)
  356.          ((equal "*includers*" (buffer-name buffer))
  357.           'energize-includers-buffer)
  358.          ((string-match "^Browser" (buffer-name buffer))
  359.           'energize-browser-buffer)
  360.          (t type)))
  361.       ((eq type 'energize-unspecified-buffer)
  362.        (signal 'error (list "buffer type unspecified" buffer)))
  363.       ((and (null type) (energize-buffer-p buffer))
  364.        (signal 'error
  365.            (list "null buffer type for energize buffer" buffer)))
  366.       (t type))))
  367.  
  368. (defun energize-extent-at (pos &optional buffer)
  369.   (let (e)
  370.     (map-extents (function (lambda (extent junk)
  371.                  (if (eq 'energize-extent-data
  372.                      (car-safe (extent-data extent)))
  373.                  ;; return non-nil
  374.                  (setq e extent))))
  375.          (or buffer (current-buffer))
  376.          pos pos nil t)
  377.     e))
  378.  
  379. ;;; Misc Energize hook functions
  380.  
  381. (defvar inside-energize-buffer-creation-hook-function nil)
  382.  
  383. (defun energize-buffer-creation-hook-function (buffer)
  384.   ;; This loser is called every time Energize wants to create a buffer,
  385.   ;; whether it is being spontaniously displayed (as by the debugger) or
  386.   ;; as a result of calling find-file -> energize-find-file-noselect ->
  387.   ;; energize-query-buffer.
  388.   (let ((inside-energize-buffer-creation-hook-function t))
  389.     ;; the above is so we can call this from normal-mode, except when
  390.     ;; we're calling normal-mode.
  391.     (save-excursion
  392.       (set-buffer buffer)
  393.  
  394.       ;; Energize always hands us truenames, or something close to them
  395.       ;; (it chomps the /tmp_mnt/ automounter cruft off.)  Let the user
  396.       ;; set up a pretty translation just like they can for normal files.
  397.       (if buffer-file-name
  398.       (setq buffer-file-name (abbreviate-file-name
  399.                   (expand-file-name buffer-file-name))
  400.         default-directory (file-name-directory buffer-file-name)))
  401.  
  402.       (if buffer-file-name (set-buffer-modtime buffer))
  403.  
  404.       (let ((type (energize-buffer-type buffer)))
  405.     (cond ((eq type 'energize-top-level-buffer)
  406.            (energize-top-level-mode))
  407.           ((eq type 'energize-browser-buffer)
  408.            (energize-browser-mode))
  409.           ((eq type 'energize-includers-buffer)
  410.            (energize-browser-mode))
  411.           ((or (eq type 'energize-error-log-buffer)
  412.            (eq type 'energize-log-file-buffer))
  413.            (energize-log-mode)
  414.            (setq buffer-read-only t))
  415.           ((eq type 'energize-project-buffer)
  416.            (if (buffer-file-name)
  417.            (energize-project-mode)
  418.          (energize-no-file-project-mode)))
  419.           ((eq type 'energize-debugger-buffer)
  420.            (energize-debugger-mode))
  421.           ((eq type 'energize-breakpoint-buffer)
  422.            (energize-breakpoint-mode))
  423.           ((eq type 'energize-unix-manual-buffer)
  424.            (energize-manual-mode))
  425.           ((or (eq type 'energize-source-buffer)
  426.            ;;(eq type 'energize-unspecified-buffer)
  427.            ;;(null type)
  428.            )
  429.            (compute-buffer-file-truename)
  430.            ;; energize-source-minor-mode is run by find-file-hooks
  431.            (if (buffer-file-name buffer)
  432.            (after-find-file nil t)
  433.          (funcall default-major-mode))
  434.            )
  435.           (t
  436.            (signal 'error (list "unknown energize buffer type" type)))))
  437.  
  438.       (if (eq (energize-buffer-type (current-buffer)) 'energize-source-buffer)
  439.       (energize-source-minor-mode))
  440.  
  441.       (energize-external-editor-set-mode buffer)
  442.       )))
  443.  
  444. (setq energize-create-buffer-hook 'energize-buffer-creation-hook-function)
  445.  
  446. ;;; Buffer modified hook
  447.  
  448. (defun notify-send-buffer-modified-request (start end)
  449.   (send-buffer-modified-request t start end))
  450.  
  451. (setq before-change-function 'notify-send-buffer-modified-request)
  452.  
  453. ;;; Energize kernel busy hook
  454.  
  455. (defun energize-message-if-not-in-minibuffer (reason)
  456.   (if (not (eq (selected-window) (minibuffer-window)))
  457.       (message reason)))
  458.  
  459. (setq energize-kernel-busy-hook 'energize-message-if-not-in-minibuffer)
  460.  
  461. ;;; set-buffer-modified-p hook
  462.  
  463. (setq energize-buffer-modified-hook 'send-buffer-modified-request)
  464.  
  465. ;;; hook in editorside.c
  466.  
  467. (setq energize-kernel-modification-hook nil)
  468.  
  469.  
  470. ;; command line
  471.  
  472. (defvar energize-args '(("-context"    . command-line-process-energize)
  473.             ("-energize"    . command-line-process-energize)
  474.             ("-beam-me-up"    . command-line-process-energize)))
  475.  
  476. (setq command-switch-alist (append command-switch-alist energize-args))
  477.  
  478. (defun command-line-process-energize (arg)
  479.   (let ((e-arg (car command-line-args-left))
  480.     (e-host (getenv "ENERGIZE_PORT"))) ; maybe nil
  481.     (if (and e-arg (string-match "\\`[0-9a-fA-F]+[,][0-9a-fA-F]+\\'" e-arg))
  482.     (setq command-line-args-left (cdr command-line-args-left))
  483.       (setq e-arg nil))
  484.     (message "Connecting to Energize...") 
  485.     (sit-for 0)
  486.     (condition-case ()
  487.     (connect-to-energize e-host e-arg)
  488.       (error
  489.        (beep)
  490.        (if e-host
  491.        (message "Failed to connect to Energize at %s." e-host)
  492.      (message "Failed to connect to Energize."))
  493.        (sit-for 1)))))
  494.  
  495.  
  496. ;;; Originally defined in screen.el
  497. ;;; If we're being invoked with -energize, then set the default
  498. ;;; screen name to "energize"
  499.  
  500. (or (fboundp 'energize-orig-multi-minibuffer-startup)
  501.     (fset 'energize-orig-multi-minibuffer-startup
  502.       (symbol-function 'multi-minibuffer-startup)))
  503.  
  504. (defun multi-minibuffer-startup (window-system-switches)
  505.   (if (let ((rest energize-args))
  506.     (catch 'foo
  507.       (while rest
  508.         (if (member (car (car rest)) command-line-args)
  509.         (throw 'foo t))
  510.         (setq rest (cdr rest)))
  511.       nil))
  512.       (setq default-screen-name "energize"))
  513.   (energize-orig-multi-minibuffer-startup window-system-switches))
  514.