This is nil for terminals, since updating a frame in a terminal
is not useful to the user.")
-(defcustom dframe-update-speed
- (if (featurep 'xemacs) 2 ; 1 is too obtrusive in XEmacs
- 1)
+(defcustom dframe-update-speed 1
"Idle time in seconds needed before dframe will update itself.
Updates occur to allow dframe to display directory information
relevant to the buffer you are currently editing."
'dframe-switch-buffer-attached-frame
map global-map)
- (if (featurep 'xemacs)
- (progn
- ;; mouse bindings so we can manipulate the items on each line
- (define-key map 'button2 'dframe-click)
- (define-key map '(shift button2) 'dframe-power-click)
- ;; Info doc fix from Bob Weiner
- (if (featurep 'infodoc)
- nil
- (define-key map 'button3 'dframe-popup-kludge))
- )
-
- ;; mouse bindings so we can manipulate the items on each line
- ;; (define-key map [down-mouse-1] 'dframe-double-click)
- (define-key map [follow-link] 'mouse-face)
- (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 unnecessary visual effect
- ;;(define-key map [down-mouse-2] 'dframe-quick-mouse)
-
- (define-key map [down-mouse-3] 'dframe-popup-kludge)
-
- ;; This lets the user scroll as if we had a scrollbar... well maybe not
- (define-key map [mode-line mouse-2] 'dframe-mouse-hscroll)
- ;; another handy place users might click to get our menu.
- (define-key map [mode-line down-mouse-1]
- 'dframe-popup-kludge)
-
- ;; We can't switch buffers with the buffer mouse menu. Lets hack it.
- (define-key map [C-down-mouse-1] 'dframe-hack-buffer-menu)
-
- ;; Lastly, we want to track the mouse. Play here
- (define-key map [mouse-movement] 'dframe-track-mouse)
- ))
+ ;; mouse bindings so we can manipulate the items on each line
+ ;; (define-key map [down-mouse-1] 'dframe-double-click)
+ (define-key map [follow-link] 'mouse-face)
+ (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 unnecessary visual effect
+ ;;(define-key map [down-mouse-2] 'dframe-quick-mouse)
+
+ (define-key map [down-mouse-3] 'dframe-popup-kludge)
+
+ ;; This lets the user scroll as if we had a scrollbar... well maybe not
+ (define-key map [mode-line mouse-2] 'dframe-mouse-hscroll)
+ ;; another handy place users might click to get our menu.
+ (define-key map [mode-line down-mouse-1]
+ 'dframe-popup-kludge)
+
+ ;; We can't switch buffers with the buffer mouse menu. Lets hack it.
+ (define-key map [C-down-mouse-1] 'dframe-hack-buffer-menu)
+
+ ;; Lastly, we want to track the mouse. Play here
+ (define-key map [mouse-movement] 'dframe-track-mouse))
(defun dframe-live-p (frame)
"Return non-nil if FRAME is currently available."
;; Declare this buffer a dedicated frame
(setq dframe-controlled local-mode-fn)
- (if (featurep 'xemacs)
- (progn
- ;; Hack the XEmacs mouse-motion handler
- (set (make-local-variable 'mouse-motion-handler)
- 'dframe-track-mouse-xemacs)
- ;; Hack the double click handler
- (make-local-variable 'mouse-track-click-hook)
- (add-hook 'mouse-track-click-hook
- (lambda (event count)
- (if (/= (event-button event) 1)
- nil ; Do normal operations.
- (cond ((eq count 1)
- (dframe-quick-mouse event))
- ((or (eq count 2)
- (eq count 3))
- (dframe-click event)
- (dframe-quick-mouse event)))
- ;; Don't do normal operations.
- t))))
- ;; Enable mouse tracking in emacs
- (if dframe-track-mouse-function
- (set (make-local-variable 'track-mouse) t))) ;this could be messy.
-;;;; DISABLED: This causes problems for users with multiple frames.
-;;;; ;; Set this up special just for the passed in buffer
-;;;; ;; Terminal minibuffer stuff does not require this.
-;;;; (if (and (or (assoc 'minibuffer parameters)
-;;;; ;; XEmacs plist is not an association list
-;;;; (member 'minibuffer parameters))
-;;;; window-system (not (eq window-system 'pc))
-;;;; (null default-minibuffer-frame))
-;;;; (progn
-;;;; (make-local-variable 'default-minibuffer-frame)
-;;;; (setq default-minibuffer-frame dframe-attached-frame))
-;;;; )
+ ;; Enable mouse tracking in emacs
+ (if dframe-track-mouse-function
+ (set (make-local-variable 'track-mouse) t)) ;this could be messy.
+
;; Override `temp-buffer-show-hook' so that help and such
;; put their stuff into a frame other than our own.
;; Correct use of `temp-buffer-show-function': Bob Weiner
(funcall dframe-controlled -1)
(set buffer-var nil)
)))))
- t t)
- )
+ t t))
;; Get the frame to work in
(if (frame-live-p (symbol-value cache-var))
(progn
(if (frame-live-p (symbol-value frame-var))
(raise-frame (symbol-value frame-var))
(set frame-var
- (if (featurep 'xemacs)
- ;; Only guess height if it is not specified.
- (if (member 'height parameters)
- (make-frame parameters)
- (make-frame (nconc (list 'height
- (dframe-needed-height))
- parameters)))
- (let* ((mh (dframe-frame-parameter dframe-attached-frame
- 'menu-bar-lines))
- (paramsa
- ;; Only add a guessed height if one is not specified
- ;; in the input parameters.
- (if (assoc 'height parameters)
- parameters
- (append
- parameters
- (list (cons 'height (+ (or mh 0) (frame-height)))))))
- (params
- ;; Only add a guessed width if one is not specified
- ;; in the input parameters.
- (if (assoc 'width parameters)
- paramsa
- (append
- paramsa
- (list (cons 'width (frame-width))))))
- (frame
- (if (not (eq window-system 'x))
- (make-frame params)
- (let ((x-pointer-shape x-pointer-top-left-arrow)
- (x-sensitive-text-pointer-shape
- x-pointer-hand2))
- (make-frame params)))))
- frame)))
+ (let* ((mh (dframe-frame-parameter dframe-attached-frame
+ 'menu-bar-lines))
+ (paramsa
+ ;; Only add a guessed height if one is not specified
+ ;; in the input parameters.
+ (if (assoc 'height parameters)
+ parameters
+ (append
+ parameters
+ (list (cons 'height (+ (or mh 0) (frame-height)))))))
+ (params
+ ;; Only add a guessed width if one is not specified
+ ;; in the input parameters.
+ (if (assoc 'width parameters)
+ paramsa
+ (append
+ paramsa
+ (list (cons 'width (frame-width))))))
+ (frame
+ (if (not (eq window-system 'x))
+ (make-frame params)
+ (let ((x-pointer-shape x-pointer-top-left-arrow)
+ (x-sensitive-text-pointer-shape
+ x-pointer-hand2))
+ (make-frame params)))))
+ frame))
;; Put the buffer into the frame
(save-excursion
(select-frame (symbol-value frame-var))
;; On a terminal, raise the frame or the user will
;; be confused.
(if (not window-system)
- (select-frame (symbol-value frame-var)))
- ))) )
-
-(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'."
- (if (featurep 'xemacs)
- (dframe-reposition-frame-xemacs new-frame parent-frame location)
- (dframe-reposition-frame-emacs new-frame parent-frame location)))
+ (select-frame (symbol-value frame-var)))))))
;; Not defined in builds without X, but behind window-system test.
(declare-function x-display-pixel-width "xfns.c" (&optional terminal))
(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
-(defun dframe-reposition-frame-emacs (new-frame parent-frame location)
+(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', `top-bottom', or
a cons cell indicating a position of the form (LEFT . TOP)."
(list (cons 'left newleft)
(cons 'top newtop))))))
-(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'."
- ;; Not yet implemented
- )
-
-;; XEmacs function only.
-(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 mode line or minibuffer
- (+ 1 (/ (frame-pixel-height frame)
- ;; This obscure code avoids a byte compiler warning in Emacs.
- (let ((f 'face-height))
- (funcall f 'default frame)))))
-
(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'."
(set cache-var nil)
;; FIXME: Looks very suspicious. Luckily this function is unused.
(make-variable-buffer-local frame-var)
- (set frame-var oldframe)
- )))
+ (set frame-var oldframe))))
;;; Special frame event proxies
(defvar dframe-setup-hook nil
(defun dframe-set-timer-internal (timeout &optional _null-on-error)
"Apply a timer with TIMEOUT to call the dframe timer manager."
(when dframe-timer
- (if (featurep 'xemacs)
- (delete-itimer dframe-timer)
- (cancel-timer dframe-timer))
+ (cancel-timer dframe-timer)
(setq dframe-timer nil))
(when timeout
- (setq dframe-timer
- (if (featurep 'xemacs)
- (start-itimer "dframe" 'dframe-timer-fn
- timeout timeout t)
- (run-with-idle-timer timeout t 'dframe-timer-fn)))))
+ (setq dframe-timer (run-with-idle-timer timeout t 'dframe-timer-fn))))
(defun dframe-timer-fn ()
"Called due to the dframe timer.
(funcall (car l)))
(setq l (cdr l)))))
-;;; Menu hacking for mouse-3
-;;
-(defconst dframe-pass-event-to-popup-mode-menu
- (let (max-args)
- (and (fboundp 'popup-mode-menu)
- (fboundp 'function-max-args)
- (setq max-args (function-max-args 'popup-mode-menu))
- (not (zerop max-args))))
- "The EVENT arg to `popup-mode-menu' was introduced in XEmacs 21.4.0.")
-
-;; In XEmacs, we make popup menus work on the item over mouse (as
-;; opposed to where the point happens to be.) We attain this by
-;; temporarily moving the point to that place.
-;; Hrvoje Nikšić <hrvoje.niksic@avl.com>
(defalias 'dframe-popup-kludge
- (if (featurep 'xemacs)
- (lambda (event) ; XEmacs.
- "Pop up a menu related to the clicked on item.
-Must be bound to EVENT."
- (interactive "e")
- (save-excursion
- (if dframe-pass-event-to-popup-mode-menu
- (popup-mode-menu event)
- (goto-char (event-closest-point event))
- (beginning-of-line)
- (forward-char (min 5 (- (line-end-position)
- (line-beginning-position))))
- (popup-mode-menu))
- ;; Wait for menu to bail out. `popup-mode-menu' (and other popup
- ;; menu functions) return immediately.
- (let (new)
- (while (not (misc-user-event-p (setq new (next-event))))
- (dispatch-event new))
- (dispatch-event new))))
-
- (lambda (e) ; Emacs.
- "Pop up a menu related to the clicked on item.
+ (lambda (e)
+ "Pop up a menu related to the clicked on item.
Must be bound to event E."
- (interactive "e")
- (save-excursion
- (mouse-set-point e)
- ;; This gets the cursor where the user can see it.
- (if (not (bolp)) (forward-char -1))
- (sit-for 0)
- (if (fboundp 'mouse-menu-major-mode-map)
- (popup-menu (mouse-menu-major-mode-map) e)
- (with-no-warnings ; don't warn about obsolete fallback
- (mouse-major-mode-menu e nil)))))))
+ (interactive "e")
+ (save-excursion
+ (mouse-set-point e)
+ ;; This gets the cursor where the user can see it.
+ (if (not (bolp)) (forward-char -1))
+ (sit-for 0)
+ (popup-menu (mouse-menu-major-mode-map) e))))
;;; Interactive user functions for the mouse
;;
(defalias 'dframe-mouse-event-p
- (if (featurep 'xemacs)
- 'button-press-event-p
- (lambda (event)
- "Return t if the event is a mouse related event."
- (if (and (listp event)
- (member (event-basic-type event)
- '(mouse-1 mouse-2 mouse-3)))
- t
- nil))))
+ (lambda (event)
+ "Return t if the event is a mouse related event."
+ (if (and (listp event)
+ (member (event-basic-type event)
+ '(mouse-1 mouse-2 mouse-3)))
+ t
+ nil)))
(defun dframe-track-mouse (event)
"For motion EVENT, display info about the current line."
(interactive "e")
(when (and dframe-track-mouse-function
- (or (featurep 'xemacs) ;; XEmacs always safe?
- (windowp (posn-window (event-end event))) ; Sometimes
+ (windowp (posn-window (event-end event)))) ; Sometimes
; there is no window to jump into.
- ))
-
(funcall dframe-track-mouse-function event)))
-(defun dframe-track-mouse-xemacs (event)
- "For motion EVENT, display info about the current line."
- (if (functionp (default-value 'mouse-motion-handler))
- (funcall (default-value 'mouse-motion-handler) event))
- (if dframe-track-mouse-function
- (funcall dframe-track-mouse-function event)))
-
(defun dframe-help-echo (_window &optional buffer position)
"Display help based context.
-The context is in WINDOW, viewing BUFFER, at POSITION.
-BUFFER and POSITION are optional because XEmacs doesn't use them."
+The context is in WINDOW, viewing BUFFER, at POSITION."
(when (and (not dframe-track-mouse-function)
(bufferp buffer)
dframe-help-echo-function)
(funcall dframe-help-echo-function))))))
(defun dframe-mouse-set-point (e)
- "Set point based on event E.
-Handles clicking on images in XEmacs."
- (if (and (featurep 'xemacs)
- (save-excursion
- (save-window-excursion
- (mouse-set-point e)
- (event-over-glyph-p e))))
- ;; We are in XEmacs, and clicked on a picture
- (let ((ext (event-glyph-extent e)))
- ;; This position is back inside the extent where the
- ;; junk we pushed into the property list lives.
- (if (extent-end-position ext)
- (goto-char (1- (extent-end-position ext)))
- (mouse-set-point e)))
- ;; We are not in XEmacs, OR we didn't click on a picture.
- (mouse-set-point e)))
+ "Set point based on event E."
+ (mouse-set-point e))
(defun dframe-quick-mouse (e)
"Since mouse events are strange, this will keep the mouse nicely positioned.
This must be bound to a mouse event.
This should be bound to mouse event E."
(interactive "e")
- ;; Emacs only. XEmacs handles this via `mouse-track-click-hook'.
(cond ((eq (car e) 'down-mouse-1)
(dframe-mouse-set-point e))
((eq (car e) 'mouse-1)
(if dframe-attached-frame (dframe-select-attached-frame))
(pop-to-buffer buffer nil)
(other-window -1)
- ;; Fix for using this hook on some platforms: Bob Weiner
- (cond ((not (featurep 'xemacs))
- (run-hooks 'temp-buffer-show-hook))
- ((fboundp 'run-hook-with-args)
- (run-hook-with-args 'temp-buffer-show-hook buffer))
- ((and (boundp 'temp-buffer-show-hook)
- (listp temp-buffer-show-hook))
- (mapcar (function (lambda (hook) (funcall hook buffer)))
- temp-buffer-show-hook))))
+ (run-hooks 'temp-buffer-show-hook))
(defun dframe-hack-buffer-menu (_e)
"Control mouse 1 is buffer menu.
Emacs frame, not in the dedicated frame.
Argument E is the event causing this activity."
(interactive "e")
- (let ((fn (lookup-key global-map (if (featurep 'xemacs)
- '(control button1)
- [C-down-mouse-1])))
+ (let ((fn (lookup-key global-map [C-down-mouse-1]))
(oldbuff (current-buffer))
(newbuff nil))
(unwind-protect
(switch-to-buffer buffer)
(call-interactively 'switch-to-buffer nil nil)))
-;; 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)
"Read a mouse event E from the mode line, and horizontally scroll.
-If the mouse is being clicked on the far left, or far right of the
-mode-line. This is only useful for non-XEmacs."
+If the mouse is being clicked on the far left, or far right of
+the mode-line."
(interactive "e")
(let* ((x-point (car (nth 2 (car (cdr e)))))
(pixels-per-10-col (/ (* 10 (frame-pixel-width))
(frame-width)))
- (click-col (1+ (/ (* 10 x-point) pixels-per-10-col)))
- )
+ (click-col (1+ (/ (* 10 x-point) pixels-per-10-col))))
(cond ((< click-col 3)
(scroll-left 2))
((> click-col (- (window-width) 5))
projects / emacs.git / commitdiff