From e46fc9b01774d0e6de8db877ca6a86b36ee832ff Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 19 Jun 2019 22:07:44 +0200 Subject: 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). --- lisp/dframe.el | 330 +++++++++++++++------------------------------------------ 1 file changed, 84 insertions(+), 246 deletions(-) diff --git a/lisp/dframe.el b/lisp/dframe.el index 473f826ad27..72deb0c45e4 100644 --- a/lisp/dframe.el +++ b/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) - - (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." @@ -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ć (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)) -- cgit v1.2.1