Mercurial > hg > xemacs-beta
diff lisp/energize/energize-init.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | 131b0175ea99 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/energize/energize-init.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,580 @@ +;;; -*- Mode:Emacs-Lisp -*- +;;; Copyright © 1990-1994 by Lucid, Inc. All Rights Reserved. + +(defvar energize-auto-raise-screen t + "If T frames are automatically raised when Energize wants to show them.") + +(defvar energize-connect-hook nil + "*Function or functions to run when the Energize connection is established.") + +(defvar energize-disconnect-hook nil + "*Function or functions to run when the Emacs/Energize connection is closed.") + + +(defvar energize-screen-mode nil) +(defvar energize-split-screens-p t) + +(defun energize-multi-screen-mode () + "Call this function to put Energize into multi-frame mode. + +A frame named \"debugger\" will be used for the *Debugger* buffer, + and its associated source files. +A frame named \"energize\" will be used for the Top-Level buffer. +A frame named \"browser\" will be created for each L.E. Browser buffer. + At most 5 of these will be created; then they will be reused. +A frame named \"project\" will be created for each Project buffer. +A frame named \"error-log\" will be created for the Error Log buffer + and its associated source files (as when the Next Error command + displays a source file.) +A frame named \"manual\" will be created for each UNIX Manual page. + At most 5 of these will be created; then they will be reused. + +If an external editor is being used, then source files will be displayed +read-only in the \"debugger\" frame. + +If an external editor is not being used, then frames named \"sources\" +will be created to edit source files. At most five of these will be +created; then they will be reused. Find-file will use the current frame, +whatever that happens to be, but find-file-other-window, and selecting +source files from the Buffers menu will use an existing frame displaying +the file in question, or create a new one if there isn't one. + +Call `energize-single-screen-mode' to turn this off. + +See the documentation for the function get-frame-for-buffer for +information on how to customize this." + (interactive) + (put 'project 'instance-limit 0) + (put 'sources 'instance-limit 5) + (put 'manual 'instance-limit 5) + (put 'browser 'instance-limit 5) + (put 'energize-debugger-mode 'frame-name 'debugger) + (put 'gdb-mode 'frame-name 'debugger) + (put 'energize-top-level-mode 'frame-name 'energize) + (put 'energize-browser-mode 'frame-name 'browser) + (put 'energize-breakpoint-mode 'frame-name 'browser) + (put 'energize-project-mode 'frame-name 'project) + (put 'energize-no-file-project-mode 'frame-name 'project) + (put 'energize-log-mode 'frame-name 'error-log) + (put 'energize-manual-entry-mode 'frame-name 'manual) + (if energize-external-editor + (setq get-frame-for-buffer-default-frame-name 'debugger) + ;; hmmmm... + (setq get-frame-for-buffer-default-frame-name 'sources)) + (setq buffers-menu-switch-to-buffer-function 'pop-to-buffer) + (setq energize-screen-mode 'multi) + t) + +(defun energize-several-screens-mode () + "Call this function to put Energize into multi-frame mode, +but with only a few frames. See also `energize-multi-screen-mode'. + +A frame named \"debugger\" will be used for the *Debugger* buffer, + and its associated source files. +A frame named \"energize\" will be used for the Top-Level buffer. +A single frame named \"browser\" will be created for L.E. Browser buffers. +A single frame named \"project\" will be created for Project buffers. +A frame named \"error-log\" will be created for the Error Log buffer + and its associated source files (as when the Next Error command + displays a source file.) +A single frame named \"manual\" will be created for UNIX Manual page buffers. + +If an external editor is being used, then source files will be displayed +read-only in the \"debugger\" frame. + +If an external editor is not being used, then a single frame named +\"sources\" will be created to edit source files. Find-file will use the +current frame, whatever that happens to be, but find-file-other-window, +and selecting source files from the Buffers menu will use an existing frame +displaying the file in question, or create a new one if there isn't one. + +Call `energize-single-screen-mode' to turn this off. + +See the documentation for the function get-frame-for-buffer for +information on how to customize this." + (interactive) + (energize-multi-screen-mode) + (remprop 'browser 'instance-limit) + (remprop 'project 'instance-limit) + (remprop 'manual 'instance-limit) + (remprop 'sources 'instance-limit) + (setq energize-screen-mode 'several) + t) + +(defun energize-single-screen-mode () + "Call this function to put Energize into single-frame mode. +All buffers will be displayed in the currently selected frame." + (interactive) + (remprop 'browser 'instance-limit) + (remprop 'project 'instance-limit) + (remprop 'manual 'instance-limit) + (remprop 'sources 'instance-limit) + (remprop 'energize-debugger-mode 'frame-name) + (remprop 'gdb-mode 'frame-name) + (remprop 'energize-top-level-mode 'frame-name) + (remprop 'energize-browser-mode 'frame-name) + (remprop 'energize-breakpoint-mode 'frame-name) + (remprop 'energize-project-mode 'frame-name) + (remprop 'energize-no-file-project-mode 'frame-name) + (remprop 'energize-log-mode 'frame-name) + (remprop 'energize-manual-entry-mode 'frame-name) + (setq get-frame-for-buffer-default-frame-name nil) + (setq buffers-menu-switch-to-buffer-function 'switch-to-buffer) + (setq energize-screen-mode 'single) + nil) + +(energize-single-screen-mode) + + +;;; Connecting and disconnecting + +(or energize-attributes-mapping + (setq energize-attributes-mapping + (purecopy + '((0 . default) + (1 . bold) + (2 . italic) + (3 . bold-italic) + (4 . attributeSmall) + (50 . attributeGlyph) + (51 . attributeSectionHeader) + (52 . attributeToplevelFormGlyph) + (53 . attributeModifiedToplevelFormGlyph) + (54 . attributeBrowserHeader) + (68 . attributeWriteProtected) + (69 . attributeModifiedText) + )))) + +;; Make the faces before emacs is dumped - this should be ok, they will be +;; initialized from the resource database when the first frame is created. +(let ((rest energize-attributes-mapping)) + (while rest + (make-face (cdr (car rest))) + (setq rest (cdr rest)))) + + +(defun any-energize-buffers-p () + (let ((rest (buffer-list)) + (result nil)) + (while rest + (if (energize-buffer-p (car rest)) + (setq result (car rest) rest nil) + (setq rest (cdr rest)))) + result)) + +(defun connect-to-energize (server &optional enarg) + "Connect this emacs to a Energize server. +The SERVER argument should be the name of the host that the kernel is +running on (empty-string for localhost). It may also be of the form +``hostname:user'' or ``:user'', meaning to use the server running with +userid USER." + (interactive (if (connected-to-energize-p) + (error "Already connected to the server.") ; you bogon. + (list (read-string "connect to energize server: ")))) + (if (connected-to-energize-p) + (error "Already connected to the server.")) ; you bogon. + (if (or (null server) (equal server "")) + (setq server (or (getenv "ENERGIZE_PORT") (system-name)))) + (setq default-frame-name "energize") + (energize-rename-things) + (energize-hack-external-editor-mode) + + (let ((energize-disconnect-hook + ;; If we're being run interactively, don't exit emacs if connecting + ;; to Energize fails! That's damn annoying. + (if (and (interactive-p) + (consp energize-disconnect-hook) + (memq 'save-buffers-kill-emacs energize-disconnect-hook)) + (delq 'save-buffers-kill-emacs + (copy-sequence energize-disconnect-hook)) + energize-disconnect-hook))) + + (connect-to-energize-internal server enarg) + ;; Wait for the Top-Level buffer to be created. + ;; This really should happen down in C, but... + (let ((p (or (get-process "energize") + (error "Could not connect to Energize."))) + b) + (while (progn + (or (connected-to-energize-p) + (error "Energize connection refused.")) + (not (setq b (any-energize-buffers-p)))) + (accept-process-output p)) + ;; Make the displayed Energize buffer initially displayed. + (pop-to-buffer b) + (delete-other-windows) + (run-hooks 'energize-connect-hook)))) + +(defun disconnect-from-energize () + (interactive) + "Close the connection to energize" + (close-connection-to-energize)) + +;;; Energizing all buffers +;; After being connected to energize this function energizes all the +;; buffers that contain files that Energize knows about. + +(defun energize-all-buffers () + "Energize any buffer showing a file that the Energize server knows about. +Has to be called after Emacs has been connected to Energize" + (if (not (connected-to-energize-p)) + (error "You have to connect to Energize first")) + (save-window-excursion + (save-excursion + (let ((buffers (buffer-list)) + (buffers-to-avoid '()) + (lock-directory nil) + buffer + filename) + (while buffers + (setq buffer (car buffers)) + (setq buffers (cdr buffers)) + (setq filename (buffer-file-name buffer)) + (set-buffer buffer) + (cond + ((and filename + (not (energize-buffer-p buffer)) + (energize-query-buffer filename t)) + (cond ((buffer-modified-p) + (if (y-or-n-p + (format + "Buffer %s must be saved to be Energized; save it? " + (buffer-name buffer))) + (progn + (set-buffer buffer) ; oh, man... + (save-buffer)) + ;; said "no" + (setq buffers-to-avoid (cons buffer buffers-to-avoid)))) + + ((and (null (verify-visited-file-modtime buffer)) + (file-exists-p filename)) + (set-buffer buffer) + (if (y-or-n-p + (format "Buffer %s has changed on disk, revert? " + (buffer-name buffer))) + (progn + (set-buffer buffer) + (revert-buffer nil t)) + ;; said "no" + (setq buffers-to-avoid (cons buffer buffers-to-avoid)))) + + ;; It's wrong to check to also see if someone else is locking + ;; the file. The file is already in the buffer, and the user + ;; isn't really modifying it -- we're just rewriting it because + ;; energize likes to do that. That's why locking should be + ;; disabled here. + ) + (if (not (memq buffer buffers-to-avoid)) + (progn + (message "Energizing buffer %s..." (buffer-name buffer)) + (find-file-noselect filename)) + (message (format "Buffer %s not Energized." (buffer-name buffer))) + (sit-for 1))))) + (message nil))))) + +(add-hook 'energize-connect-hook 'energize-all-buffers) + + +;; This is called when the connection to Energize is lose (for whatever +;; reason). We could just run the energize-disconnect-hook from C and +;; put this function on it, but then the user could hurt themselves. +;; +(defun de-energize-all-buffers () + (save-excursion + (let ((buffers (buffer-list)) + buffer) + (while buffers + (condition-case condition + (progn + (setq buffer (car buffers)) + (set-buffer buffer) + (cond ((not (energize-buffer-p buffer)) + nil) + ((eq (energize-buffer-type buffer) 'energize-source-buffer) + (map-extents + (function (lambda (extent ignore) + (if (extent-property extent 'energize) + (delete-extent extent)) + nil)) + buffer) + (remove-hook 'write-file-data-hooks + 'energize-write-data-hook) + (setq revert-buffer-insert-file-contents-function nil) + (ad-Orig-normal-mode-after-energize) ; #### necessary? + ) + (t ; non-source-file Energize buffers + (set-buffer-modified-p nil) + (if (eq (other-buffer buffer) buffer) + (set-buffer (get-buffer-create "*scratch*")) + (set-buffer (other-buffer buffer))) + (kill-buffer buffer)))) + (error ;; condition-case clause + (beep) + (message "Error while de-Energizing: %s" condition))) + (setq buffers (cdr buffers))))) + ;; now clean the menubar + (deactivate-all-energize-menu-items) + (energize-rename-things 'back) + (run-hooks 'energize-disconnect-hook) + nil) + + +(defun energize-rename-things (&optional back) + ;; People who don't like emacs don't like seeing the word "Emacs" either + (let ((case-fold-search t)) + (if (and (consp mode-line-buffer-identification) + (stringp (car mode-line-buffer-identification)) + (string-match (if back "\\bEnergize\\b" + "\\bL?Emacs\\([- \t]*[-._0-9]+\\)?\\b") + (car mode-line-buffer-identification))) + (setq-default mode-line-buffer-identification + (cons + (concat (substring (car mode-line-buffer-identification) + 0 (match-beginning 0)) + (if back "Emacs" "Energize") + (substring (car mode-line-buffer-identification) + (match-end 0))) + (cdr mode-line-buffer-identification)))) +; (if (stringp frame-title-format) +; (if back +; (if (string-match "^Energize\\b ?" frame-title-format) +; (setq-default frame-title-format "%S: %b")) +; (or (string-match "Energize" frame-title-format) +; (setq-default frame-title-format "Energize: %b")))) + ) + nil) + + + +;;; The kernel is very random about the buffer-types it returns. +;;; This is a temporary permanent fix... + +(defun energize-buffer-type (buffer) + "Returns a symbol denoting the type of an Energize buffer, or nil." + (let ((type (energize-buffer-type-internal buffer))) + (cond ((eq type 'energize-top-level-buffer) + (cond ((equal "Error Log" (buffer-name buffer)) + 'energize-error-log-buffer) + ((equal "*includers*" (buffer-name buffer)) + 'energize-includers-buffer) + ((string-match "^Browser" (buffer-name buffer)) + 'energize-browser-buffer) + (t type))) + ((eq type 'energize-unspecified-buffer) + (signal 'error (list "buffer type unspecified" buffer))) + ((and (null type) (energize-buffer-p buffer)) + (signal 'error + (list "null buffer type for energize buffer" buffer))) + (t type)))) + +(defun energize-extent-at (pos &optional buffer) + (extent-at pos buffer 'energize)) + +(defun non-energize-errors-exist-p () + ;; Whether `next-error' executed right now should do the emacs thing. + ;; If we're in a *grep* or *compile* buffer, always do the emacs thing. + ;; If we're in the Error Log, always do the Energize thing. + ;; Otherwise, do the emacs thing if it would succeed; otherwise do the + ;; Energize thing. + (or (compilation-buffer-p (current-buffer)) ; in *grep* + (and (not (eq (energize-buffer-type (current-buffer)) ; in ErrLog + 'energize-error-log-buffer)) + ;; defined in compile.el (a XEmacs addition). + (compilation-errors-exist-p)))) + + +;;; Misc Energize hook functions + +(defvar inside-energize-buffer-creation-hook-function nil) + +(defun energize-buffer-creation-hook-function (buffer) + ;; This loser is called every time Energize wants to create a buffer, + ;; whether it is being spontaniously displayed (as by the debugger) or + ;; as a result of calling find-file -> energize-find-file-noselect -> + ;; energize-query-buffer. + (let ((inside-energize-buffer-creation-hook-function t)) + ;; the above is so we can call this from normal-mode, except when + ;; we're calling normal-mode. + (save-excursion + (set-buffer buffer) + + ;; Energize always hands us truenames, or something close to them + ;; (it chomps the /tmp_mnt/ automounter cruft off.) Let the user + ;; set up a pretty translation just like they can for normal files. + (if buffer-file-name + (setq buffer-file-name (abbreviate-file-name + (expand-file-name buffer-file-name)) + default-directory (file-name-directory buffer-file-name)) + (setq default-directory + (abbreviate-file-name (expand-file-name default-directory)))) + + (if buffer-file-name (set-buffer-modtime buffer)) + + (let ((type (energize-buffer-type buffer))) + (cond ((eq type 'energize-top-level-buffer) + (energize-top-level-mode)) + ((eq type 'energize-browser-buffer) + (energize-browser-mode)) + ((eq type 'energize-includers-buffer) + (energize-browser-mode)) + ((or (eq type 'energize-error-log-buffer) + (eq type 'energize-log-file-buffer)) + (energize-log-mode) + (setq buffer-read-only t)) + ((eq type 'energize-project-buffer) + (if (buffer-file-name) + (energize-project-mode) + (energize-no-file-project-mode))) + ((eq type 'energize-debugger-buffer) + (energize-debugger-mode)) + ((eq type 'energize-breakpoint-buffer) + (energize-breakpoint-mode)) + ((eq type 'energize-unix-manual-buffer) + (energize-manual-mode)) + ((or (eq type 'energize-source-buffer) + ;;(eq type 'energize-unspecified-buffer) + ;;(null type) + ) + (compute-buffer-file-truename) + (if (buffer-file-name buffer) + (after-find-file nil t) + (funcall default-major-mode)) + ) + (t + (signal 'error (list "unknown energize buffer type" type))))) + + (if (eq (energize-buffer-type (current-buffer)) 'energize-source-buffer) + (energize-source-minor-mode)) + + (energize-external-editor-set-mode buffer) + ))) + +(setq energize-create-buffer-hook 'energize-buffer-creation-hook-function) + +;;; Buffer modified hook + +(defun energize-send-buffer-modified-1 (start end) + (if (not (energize-buffer-p (current-buffer))) + nil + (map-extents #'(lambda (ext ignore) + (and (extent-property ext 'energize) + (set-extent-face ext 'attributeModifiedText)) + nil) + (current-buffer) start end) + (energize-send-buffer-modified t start end))) + +(add-hook 'before-change-functions 'energize-send-buffer-modified-1) + +;;; Reverting buffers +;;; This is called when Energize has informed us that a buffer has changed +;;; on disk, and we need to revert. + +(defun energize-auto-revert-buffer (buf) + (cond ((not (file-exists-p (buffer-file-name buf))) + ;; Signal an error here? Naah, let someone else deal with it. + nil) + ;; If it's not modified, just revert. If it is modified, ask. + ((or (not (buffer-modified-p buf)) + (yes-or-no-p + (format "File %s changed on disk. Discard your edits? " + (file-name-nondirectory (buffer-file-name buf))))) + (save-excursion + (set-buffer buf) + (revert-buffer t t))))) + +;;; Energize kernel busy hook + +(defun energize-message-if-not-in-minibuffer (reason) + (if (not (eq (selected-window) (minibuffer-window))) + (message reason))) + +(setq energize-kernel-busy-hook 'energize-message-if-not-in-minibuffer) + +;;; set-buffer-modified-p hook + +(defun energize-send-buffer-modified-2 (state start end) + (if (not (energize-buffer-p (current-buffer))) + nil + (if (not state) + ;; If we're unmodifying the buffer, un-highlight all Energize extents. + (let ((e (next-extent (current-buffer)))) + (while e + (if (and (extent-property e 'energize) + (eq (extent-face e) 'attributeModifiedText)) + (set-extent-face e nil)) + (setq e (next-extent e))))) + (energize-send-buffer-modified state start end))) + +(setq energize-buffer-modified-hook 'energize-send-buffer-modified-2) + +;;; hook in editorside.c + +(setq energize-kernel-modification-hook nil) + + +;; command line + +(defconst energize-args '(("-energize" . command-line-process-energize) + ("-context" . command-line-process-energize-1) + ("-beam-me-up" . command-line-process-energize-1))) + +(setq command-switch-alist (append command-switch-alist energize-args)) + +(fset 'command-line-process-energize 'command-line-process-energize-1) +(put 'command-line-process-energize-1 'undocumented t) +(defun command-line-process-energize-1 (arg) + "Connect to the Energize server at $ENERGIZE_PORT." + (let ((e-arg (car command-line-args-left)) + (e-host (getenv "ENERGIZE_PORT"))) ; maybe nil + (if (and e-arg (string-match "\\`[0-9a-fA-F]+[,][0-9a-fA-F]+\\'" e-arg)) + (setq command-line-args-left (cdr command-line-args-left)) + (setq e-arg nil)) + (message "Connecting to Energize...") + (sit-for 0) + (condition-case () + (connect-to-energize e-host e-arg) + (error + (beep) + (if e-host + (message "Failed to connect to Energize at %s." e-host) + (message "Failed to connect to Energize.")) + (sit-for 1))))) + + +;;; Originally defined in frame.el +;;; If we're being invoked with -energize, then set the default +;;; frame name to "energize" +;;; This is a total kludge; there ought to be a hook that gets +;;; run before the first frame is created (either before or +;;; after term/x-win.el is loaded.) + +(or (fboundp 'energize-orig-frame-initialize) + (fset 'energize-orig-frame-initialize + (symbol-function 'frame-initialize))) + +(defun frame-initialize () + (if (let ((rest energize-args)) + (catch 'done + (while rest + (if (member (car (car rest)) command-line-args) + (throw 'done t)) + (setq rest (cdr rest))) + nil)) + (setq default-frame-name "energize")) + (energize-orig-frame-initialize)) + +(defun energize-x-initializations () + (cond ((not noninteractive) + (energize-define-function-keys) + (energize-configure-font-lock-mode t (not (x-color-display-p)) t) + ;; faces will be initialized from the resource database when the first + ;; frame is created. + (let ((rest energize-attributes-mapping)) + (while rest + (make-face (cdr (car rest))) + (setq rest (cdr rest)))) + ))) + +;; Do these bindings after connecting to the X server, but before +;;; loading any init files, so that init files can override them. +(add-hook 'before-init-hook 'energize-x-initializations)