X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3726946669effb8c66c37fb5f9996178c9adfc80..058e8562775571790e48b1614e84a9617a9e1e17:/lisp/dframe.el diff --git a/lisp/dframe.el b/lisp/dframe.el index 59849e98c9..b6605d1065 100644 --- a/lisp/dframe.el +++ b/lisp/dframe.el @@ -1,6 +1,6 @@ -;;; dframe --- dedicate frame support modes +;;; dframe --- dedicate frame support modes -*- lexical-binding:t -*- -;; Copyright (C) 1996-2012 Free Software Foundation, Inc. +;; Copyright (C) 1996-2016 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Keywords: file, tags, tools @@ -262,9 +262,15 @@ This buffer will have `dframe-frame-mode' run on it. FRAME-NAME is the name of the frame to create. LOCAL-MODE-FN is the function used to call this one. PARAMETERS are frame parameters to apply to this dframe. -DELETE-HOOK are hooks to run when deleting a frame. -POPUP-HOOK are hooks to run before showing a frame. -CREATE-HOOK are hooks to run after creating a frame." +DELETE-HOOK is a hook to run when deleting a frame. +POPUP-HOOK is a hook to run before showing a frame. +CREATE-HOOK is a hook to run after creating a frame." + (let ((conv-hook (lambda (val) + (let ((sym (make-symbol "hook"))) + (set sym val) sym)))) + (if (consp delete-hook) (setq delete-hook (funcall conv-hook delete-hook))) + (if (consp create-hook) (setq create-hook (funcall conv-hook create-hook))) + (if (consp popup-hook) (setq popup-hook (funcall conv-hook popup-hook)))) ;; toggle frame on and off. (if (not arg) (if (dframe-live-p (symbol-value frame-var)) (setq arg -1) (setq arg 1))) @@ -273,7 +279,7 @@ CREATE-HOOK are hooks to run after creating a frame." ;; turn the frame off on neg number (if (and (numberp arg) (< arg 0)) (progn - (run-hooks 'delete-hook) + (run-hooks delete-hook) (if (and (symbol-value frame-var) (frame-live-p (symbol-value frame-var))) (progn @@ -282,7 +288,7 @@ CREATE-HOOK are hooks to run after creating a frame." (set frame-var nil)) ;; Set this as our currently attached frame (setq dframe-attached-frame (selected-frame)) - (run-hooks 'popup-hook) + (run-hooks popup-hook) ;; Updated the buffer passed in to contain all the hacks needed ;; to make it work well in a dedicated window. (with-current-buffer (symbol-value buffer-var) @@ -334,15 +340,15 @@ CREATE-HOOK are hooks to run after creating a frame." (setq temp-buffer-show-function 'dframe-temp-buffer-show-function) ;; If this buffer is killed, we must make sure that we destroy ;; the frame the dedicated window is in. - (add-hook 'kill-buffer-hook `(lambda () - (let ((skilling (boundp 'skilling))) - (if skilling - nil - (if dframe-controlled - (progn - (funcall dframe-controlled -1) - (setq ,buffer-var nil) - ))))) + (add-hook 'kill-buffer-hook (lambda () + (let ((skilling (boundp 'skilling))) + (if skilling + nil + (if dframe-controlled + (progn + (funcall dframe-controlled -1) + (set buffer-var nil) + ))))) t t) ) ;; Get the frame to work in @@ -399,7 +405,7 @@ CREATE-HOOK are hooks to run after creating a frame." (switch-to-buffer (symbol-value buffer-var)) (set-window-dedicated-p (selected-window) t)) ;; Run hooks (like reposition) - (run-hooks 'create-hook) + (run-hooks create-hook) ;; Frame name (if (and (or (null window-system) (eq window-system 'pc)) (fboundp 'set-frame-name)) @@ -414,7 +420,7 @@ CREATE-HOOK are hooks to run after creating a frame." (defun dframe-reposition-frame (new-frame parent-frame location) "Move NEW-FRAME to be relative to PARENT-FRAME. -LOCATION can be one of 'random, 'left, 'right, 'left-right, or 'top-bottom." +LOCATION can be one of `random', `left', `right', `left-right', or `top-bottom'." (if (featurep 'xemacs) (dframe-reposition-frame-xemacs new-frame parent-frame location) (dframe-reposition-frame-emacs new-frame parent-frame location))) @@ -425,7 +431,7 @@ LOCATION can be one of 'random, 'left, 'right, 'left-right, or 'top-bottom." (defun dframe-reposition-frame-emacs (new-frame parent-frame location) "Move NEW-FRAME to be relative to PARENT-FRAME. -LOCATION can be one of 'random, 'left-right, 'top-bottom, or +LOCATION can be one of `random', `left-right', `top-bottom', or a cons cell indicating a position of the form (LEFT . TOP)." ;; Position dframe. ;; Do no positioning if not on a windowing system, @@ -508,7 +514,7 @@ a cons cell indicating a position of the form (LEFT . TOP)." (defun dframe-reposition-frame-xemacs (_new-frame _parent-frame _location) "Move NEW-FRAME to be relative to PARENT-FRAME. -LOCATION can be one of 'random, 'left-right, or 'top-bottom." +LOCATION can be one of `random', `left-right', or `top-bottom'." ;; Not yet implemented ) @@ -524,7 +530,7 @@ LOCATION can be one of 'random, 'left-right, or 'top-bottom." (defun dframe-detach (frame-var cache-var buffer-var) "Detach the frame in symbol FRAME-VAR. -CACHE-VAR and BUFFER-VAR are symbols as in `dframe-frame-mode'" +CACHE-VAR and BUFFER-VAR are symbols as in `dframe-frame-mode'." (with-current-buffer (symbol-value buffer-var) (rename-buffer (buffer-name) t) (let ((oldframe (symbol-value frame-var))) @@ -600,13 +606,12 @@ Argument E is the event deleting the frame." ;;; Utilities ;; -(defun dframe-get-focus (frame-var activator &optional hook) +(defun dframe-get-focus (frame-var activator) "Change frame focus to or from a dedicated frame. If the selected frame is not in the symbol FRAME-VAR, then FRAME-VAR frame is selected. If the FRAME-VAR is active, then select the attached frame. If FRAME-VAR is nil, ACTIVATOR is called to -created it. HOOK is an optional argument of hooks to run when -selecting FRAME-VAR." +created it." (interactive) (if (eq (selected-frame) (symbol-value frame-var)) (if (frame-live-p dframe-attached-frame) @@ -617,9 +622,7 @@ selecting FRAME-VAR." ;; go there (select-frame (symbol-value frame-var)) ) - (other-frame 0) - ;; If updates are off, then refresh the frame (they want it now...) - (run-hooks 'hook)) + (other-frame 0)) (defun dframe-close-frame () @@ -681,15 +684,15 @@ Optionally select that frame if necessary." "Non-nil means that `dframe-message' should just return a string.") (defun dframe-message (fmt &rest args) - "Like message, but for use in a dedicated frame. + "Like `message', but for use in a dedicated frame. Argument FMT is the format string, and ARGS are the arguments for message." (save-selected-window (if dframe-suppress-message-flag - (apply 'format fmt args) + (apply #'format-message fmt args) (if dframe-attached-frame ;; KB: Here we do not need calling `dframe-select-attached-frame' (select-frame dframe-attached-frame)) - (apply 'message fmt args)))) + (apply #'message fmt args)))) (defun dframe-y-or-n-p (prompt) "Like `y-or-n-p', but for use in a dedicated frame. @@ -755,9 +758,8 @@ who requested the timer. NULL-ON-ERROR is ignored." Evaluates all cached timer functions in sequence." (let ((l dframe-client-functions)) (while (and l (sit-for 0)) - (condition-case er - (funcall (car l)) - (error (message "DFRAME TIMER ERROR: %S" er))) + (with-demoted-errors "DFRAME TIMER ERROR: %S" + (funcall (car l))) (setq l (cdr l))))) ;;; Menu hacking for mouse-3