Remove XEmacs compat code from dframe.el
* lisp/dframe.el (dframe-update-speed, dframe-update-keymap) (dframe-frame-mode, dframe-detach, dframe-set-timer-internal) (dframe-popup-kludge, dframe-mouse-event-p) (dframe-track-mouse, dframe-help-echo, dframe-mouse-set-point) (dframe-double-click, dframe-temp-buffer-show-function) (dframe-hack-buffer-menu, dframe-mouse-hscroll): Remove XEmacs compat code (and some ancient Emacs compat code).
This commit is contained in:
Lars Ingebrigtsen
parent
613d3848b8
commit
e46fc9b017
1 changed files with 80 additions and 242 deletions
322
lisp/dframe.el
322
lisp/dframe.el
|
|
@ -135,9 +135,7 @@
|
|||
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."
|
||||
|
|
@ -204,40 +202,28 @@ Local to those buffers, as a function called that created it.")
|
|||
'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)
|
||||
|
||||
;; 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)
|
||||
|
||||
(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)
|
||||
|
||||
;; 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)
|
||||
|
||||
;; 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)
|
||||
))
|
||||
;; 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."
|
||||
|
|
@ -296,40 +282,10 @@ CREATE-HOOK is a hook to run after creating a frame."
|
|||
;; 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
|
||||
|
|
@ -350,8 +306,7 @@ CREATE-HOOK is a hook to run after creating a frame."
|
|||
(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
|
||||
|
|
@ -367,39 +322,32 @@ CREATE-HOOK is a hook to run after creating a frame."
|
|||
(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))
|
||||
|
|
@ -416,21 +364,13 @@ CREATE-HOOK is a hook to run after creating a frame."
|
|||
;; 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)."
|
||||
|
|
@ -513,22 +453,6 @@ 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'."
|
||||
|
|
@ -540,8 +464,7 @@ 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
|
||||
|
|
@ -748,16 +671,10 @@ who requested the timer. NULL-ON-ERROR is ignored."
|
|||
(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.
|
||||
|
|
@ -768,90 +685,40 @@ Evaluates all cached timer functions in sequence."
|
|||
(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)
|
||||
|
|
@ -862,22 +729,8 @@ BUFFER and POSITION are optional because XEmacs doesn't use them."
|
|||
(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.
|
||||
|
|
@ -912,7 +765,6 @@ E is the event causing the click."
|
|||
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)
|
||||
|
|
@ -933,15 +785,7 @@ redirected into a window on the attached frame."
|
|||
(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.
|
||||
|
|
@ -949,9 +793,7 @@ This hack overrides it so that the right thing happens in the main
|
|||
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
|
||||
|
|
@ -977,19 +819,15 @@ broken because of the dedicated frame."
|
|||
(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))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue