-;;; dframe --- dedicate frame support modes
+;;; dframe --- dedicate frame support modes -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2016 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
;; c) If successful (your -frame variable has a value), call
;; timer setup if applicable.
;; your-frame-reposition- -- Function to call from after-create-hook to
-;; reposition your frame with `dframe-repsoition-frame'.
+;; reposition your frame with `dframe-reposition-frame'.
;; your-mode -- Set up the major mode of the buffer for your app.
;; Set these variables: dframe-track-mouse-function,
;; dframe-help-echo-function,
:type 'hook)
(defvar dframe-track-mouse-function nil
- "*A function to call when the mouse is moved in the given frame.
+ "A function to call when the mouse is moved in the given frame.
Typically used to display info about the line under the mouse.")
(make-variable-buffer-local 'dframe-track-mouse-function)
(defvar dframe-help-echo-function nil
- "*A function to call when help-echo is used in newer versions of Emacs.
+ "A function to call when help-echo is used in newer versions of Emacs.
Typically used to display info about the line under the mouse.")
(make-variable-buffer-local 'dframe-help-echo-function)
(defvar dframe-mouse-click-function nil
- "*A function to call when the mouse is clicked.
+ "A function to call when the mouse is clicked.
Valid clicks are mouse 2, our double mouse 1.")
(make-variable-buffer-local 'dframe-mouse-click-function)
(defvar dframe-mouse-position-function nil
- "*A function to call to position the cursor for a mouse click.")
+ "A function to call to position the cursor for a mouse click.")
(make-variable-buffer-local 'dframe-mouse-position-function)
(defvar dframe-power-click nil
(define-key map [mouse-2] 'dframe-click)
;; This is the power click for new frames, or refreshing a cache
(define-key map [S-mouse-2] 'dframe-power-click)
- ;; This adds a small unecessary visual effect
+ ;; This adds a small unnecessary visual effect
;;(define-key map [down-mouse-2] 'dframe-quick-mouse)
(define-key map [down-mouse-3] 'dframe-popup-kludge)
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)))
;; 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
(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)
(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
(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))
(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)))
(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,
(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
)
(defun dframe-needed-height (&optional frame)
"The needed height for the tool bar FRAME (in characters)."
(or frame (setq frame (selected-frame)))
- ;; The 1 is the missing modeline/minibuffer
+ ;; The 1 is the missing mode line or minibuffer
(+ 1 (/ (frame-pixel-height frame)
;; This obscure code avoids a byte compiler warning in Emacs.
(let ((f 'face-height))
(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)))
;;; 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)
;; 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 ()
"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.
(defun dframe-set-timer (timeout fn &optional _null-on-error)
"Apply a timer with TIMEOUT, to call FN, or remove a timer if TIMEOUT is nil.
-TIMEOUT is the number of seconds until the dframe controled program
+TIMEOUT is the number of seconds until the dframe controlled program
timer is called again. When TIMEOUT is nil, turn off all timeouts.
This function must be called from the buffer belonging to the program
who requested the timer. NULL-ON-ERROR is ignored."
(if timeout
(add-to-list 'dframe-client-functions fn)
(setq dframe-client-functions (delete fn dframe-client-functions)))
- ;; Now decided what to do about the timout.
+ ;; Now decided what to do about the timeout.
(if (or
;; We have a timer, restart the timer with the new time.
timeout
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
(switch-to-buffer buffer)
(call-interactively 'switch-to-buffer nil nil)))
-;; XEmacs: this can be implemented using modeline keymaps, but there
+;; XEmacs: this can be implemented using mode line keymaps, but there
;; is no use, as we have horizontal scrollbar (as the docstring
;; hints.)
(defun dframe-mouse-hscroll (e)
((> click-col (- (window-width) 5))
(scroll-right 2))
(t (dframe-message
- "Click on the edge of the modeline to scroll left/right")))
- ))
+ "Click on the edge of the mode line to scroll left/right")))))
(provide 'dframe)