commit a7e302dc1dc18770aaf9eeedfd638f73b574bc19 (HEAD, refs/remotes/origin/master) Author: Dmitry Antipov Date: Tue Jul 5 08:33:29 2016 +0300 Prefer 'frame-parameter' where it is expected to be a bit faster * lisp/international/mule-diag.el (mule-diag): * lisp/menu-bar.el (menu-bar-showhide-scroll-bar-menu): * lisp/mouse.el (mouse-drag-line, font-menu-add-default): * lisp/scroll-bar.el (toggle-scroll-bar, toggle-horizontal-scroll-bar): * lisp/faces.el (x-resolve-font-name): Use 'frame-parameter'. diff --git a/lisp/faces.el b/lisp/faces.el index d5fc3ce..426de3b 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2881,7 +2881,7 @@ also the same size as FACE on FRAME, or fail." pattern face))) (error "No fonts match `%s'" pattern))) (car fonts)) - (cdr (assq 'font (frame-parameters (selected-frame)))))) + (frame-parameter nil 'font))) (defcustom font-list-limit 100 "This variable is obsolete and has no effect." diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 731d688..f543083 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -1114,7 +1114,7 @@ system which uses fontsets)." (insert "\n\n") (if window-system - (let ((font (cdr (assq 'font (frame-parameters))))) + (let ((font (frame-parameter nil 'font))) (insert "The font and fontset of the selected frame are:\n" " font: " font "\n" " fontset: " (face-attribute 'default :fontset) "\n")) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index a654118..c4f094a 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -989,49 +989,43 @@ The selected font will be the default on both the existing and future frames." (customize-set-variable 'horizontal-scroll-bar-mode nil)) (defvar menu-bar-showhide-scroll-bar-menu - (let ((menu (make-sparse-keymap "Scroll-bar"))) + (let ((menu (make-sparse-keymap "Scroll-bar")) + (vsb (frame-parameter nil 'vertical-scroll-bars)) + (hsb (frame-parameter nil 'horizontal-scroll-bars))) (bindings--define-key menu [horizontal] '(menu-item "Horizontal" menu-bar-horizontal-scroll-bar :help "Horizontal scroll bar" :visible (horizontal-scroll-bars-available-p) - :button (:radio . (cdr (assq 'horizontal-scroll-bars - (frame-parameters)))))) + :button (:radio . hsb))) (bindings--define-key menu [none-horizontal] '(menu-item "None-horizontal" menu-bar-no-horizontal-scroll-bar :help "Turn off horizontal scroll bars" :visible (horizontal-scroll-bars-available-p) - :button (:radio . (not (cdr (assq 'horizontal-scroll-bars - (frame-parameters))))))) + :button (:radio . (not hsb)))) (bindings--define-key menu [right] '(menu-item "On the Right" menu-bar-right-scroll-bar :help "Scroll-bar on the right side" :visible (display-graphic-p) - :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) - 'right)))) + :button (:radio . (eq vsb 'right)))) (bindings--define-key menu [left] '(menu-item "On the Left" menu-bar-left-scroll-bar :help "Scroll-bar on the left side" :visible (display-graphic-p) - :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) - 'left)))) + :button (:radio . (eq vsb 'left)))) (bindings--define-key menu [none] '(menu-item "None" menu-bar-no-scroll-bar :help "Turn off scroll-bar" :visible (display-graphic-p) - :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) - nil)))) + :button (:radio . (nilp vsb)))) menu)) (defun menu-bar-frame-for-menubar () diff --git a/lisp/mouse.el b/lisp/mouse.el index 8d72753..53d5a22 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -420,10 +420,8 @@ must be one of the symbols `header', `mode', or `vertical'." (let ((divider-width (frame-right-divider-width frame))) (when (and (or (not (numberp divider-width)) (zerop divider-width)) - (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters frame))) - 'left)) - (setq window (window-in-direction 'left window t)))))) + (eq (frame-parameter frame 'vertical-scroll-bars) 'left)) + (setq window (window-in-direction 'left window t)))))) (let* ((exitfun nil) (move @@ -1705,7 +1703,7 @@ and selects that window." ;; Font selection. (defun font-menu-add-default () - (let* ((default (cdr (assq 'font (frame-parameters (selected-frame))))) + (let* ((default (frame-parameter nil 'font)) (font-alist x-fixed-font-alist) (elt (or (assoc "Misc" font-alist) (nth 1 font-alist)))) (if (assoc "Default" elt) diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 838f9bf..e5fe316 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -183,9 +183,7 @@ when they are turned on; if it is nil, they go on the left." (interactive "P") (if (null arg) (setq arg - (if (cdr (assq 'vertical-scroll-bars - (frame-parameters (selected-frame)))) - -1 1)) + (if (frame-parameter nil 'vertical-scroll-bars) -1 1)) (setq arg (prefix-numeric-value arg))) (modify-frame-parameters (selected-frame) @@ -199,9 +197,7 @@ With ARG, turn vertical scroll bars on if and only if ARG is positive." (interactive "P") (if (null arg) (setq arg - (if (cdr (assq 'horizontal-scroll-bars - (frame-parameters (selected-frame)))) - -1 1)) + (if (frame-parameter nil 'horizontal-scroll-bars) -1 1)) (setq arg (prefix-numeric-value arg))) (modify-frame-parameters (selected-frame) commit b1a64dba04146b1424eacd3bc363e5f0edeac2b2 Author: Dmitry Antipov Date: Wed Jul 6 06:03:12 2016 +0300 Reduce consing caused by vertical motion commands * src/frame.c (Fframe_parameter): Avoid call to Fframe_parameters for the parameters frequently requested by calls to 'next-line' and 'previous-line'. diff --git a/src/frame.c b/src/frame.c index 540b69f..22143ab 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2607,6 +2607,22 @@ If FRAME is nil, describe the currently selected frame. */) /* Avoid consing in frequent cases. */ if (EQ (parameter, Qname)) value = f->name; +#ifdef HAVE_WINDOW_SYSTEM + /* These are used by vertical motion commands. */ + else if (EQ (parameter, Qvertical_scroll_bars)) + value = (f->vertical_scroll_bar_type == vertical_scroll_bar_none + ? Qnil + : (f->vertical_scroll_bar_type == vertical_scroll_bar_left + ? Qleft : Qright)); + else if (EQ (parameter, Qhorizontal_scroll_bars)) + value = f->horizontal_scroll_bars ? Qt : Qnil; + else if (EQ (parameter, Qline_spacing) && f->extra_line_spacing == 0) + /* If this is non-zero, we can't determine whether the user specified + an integer or float value without looking through 'param_alist'. */ + value = make_number (0); + else if (EQ (parameter, Qfont) && FRAME_X_P (f)) + value = FRAME_FONT (f)->props[FONT_NAME_INDEX]; +#endif /* HAVE_WINDOW_SYSTEM */ #ifdef HAVE_X_WINDOWS else if (EQ (parameter, Qdisplay) && FRAME_X_P (f)) value = XCAR (FRAME_DISPLAY_INFO (f)->name_list_element); commit 1ba6f2c7bbacfda2bb014d30cfb3999146943de8 Author: Michael Albinus Date: Tue Jul 5 21:16:25 2016 +0200 Make all Tramp tests pass for "gdrive" method * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-delete-directory) * lisp/net/tramp-compat.el (tramp-compat-copy-directory) (tramp-compat-delete-directory): * lisp/net/tramp-smb.el (tramp-smb-handle-delete-directory): Use `directory-files-no-dot-files-regexp'. * lisp/net/tramp-gvfs.el (tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-send-command): Call `tramp-flush-file-property' in case of problems. * test/lisp/net/tramp-tests.el (tramp--instrument-test-case): Adapt docstring. (tramp-test14-delete-directory): Make further tests. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 0e9fcb5..c84fb5a 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -174,8 +174,7 @@ Add the extension of F, if existing." (tramp-compat-copy-directory file newname keep-time parents) (copy-file file newname t keep-time))) ;; We do not want to delete "." and "..". - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + (directory-files directory 'full directory-files-no-dot-files-regexp)) ;; Set directory attributes. (set-file-modes newname (file-modes directory)) @@ -209,13 +208,13 @@ Add the extension of F, if existing." ;; implementation from Emacs 23.2. (wrong-number-of-arguments (setq directory (directory-file-name (expand-file-name directory))) - (if (not (file-symlink-p directory)) - (mapc (lambda (file) - (if (eq t (car (file-attributes file))) - (tramp-compat-delete-directory file recursive trash) - (tramp-compat-delete-file file trash))) - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) + (when (not (file-symlink-p directory)) + (mapc (lambda (file) + (if (eq t (car (file-attributes file))) + (tramp-compat-delete-directory file recursive trash) + (tramp-compat-delete-file file trash))) + (directory-files + directory 'full directory-files-no-dot-files-regexp))) (delete-directory directory)))) (defun tramp-compat-process-running-p (process-name) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 8e7ef0f..a22bd89 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -746,14 +746,18 @@ file names." (defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (when (and recursive (not (file-symlink-p directory))) - (mapc (lambda (file) - (if (eq t (car (file-attributes file))) - (tramp-compat-delete-directory file recursive trash) - (tramp-compat-delete-file file trash))) - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) (with-parsed-tramp-file-name directory nil + (if (and recursive (not (file-symlink-p directory))) + (mapc (lambda (file) + (if (eq t (car (file-attributes file))) + (tramp-compat-delete-directory file recursive trash) + (tramp-compat-delete-file file trash))) + (directory-files + directory 'full directory-files-no-dot-files-regexp)) + (when (directory-files directory nil directory-files-no-dot-files-regexp) + (tramp-error + v 'file-error "Couldn't delete non-empty %s" directory))) + (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-directory-property v localname) (unless @@ -1409,7 +1413,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." signal-name (tramp-gvfs-stringify-dbus-message mount-info)) (tramp-set-file-property v "/" "list-mounts" 'undef) (if (string-equal (downcase signal-name) "unmounted") - (tramp-set-file-property v "/" "fuse-mountpoint" nil) + (tramp-flush-file-property v "/") ;; Set prefix, mountpoint and location. (unless (string-equal prefix "/") (tramp-set-file-property v "/" "prefix" prefix)) @@ -1701,7 +1705,9 @@ COMMAND is usually a command from the gvfs-* utilities. (with-current-buffer (tramp-get-connection-buffer vec) (tramp-gvfs-maybe-open-connection vec) (erase-buffer) - (zerop (apply 'tramp-call-process vec command nil t nil args))))) + (or (zerop (apply 'tramp-call-process vec command nil t nil args)) + ;; Remove information about mounted connection. + (and (tramp-flush-file-property vec "/") nil))))) ;; D-Bus BLUEZ functions. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index a526fd9..1c43ce2 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -597,15 +597,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Like `delete-directory' for Tramp files." (setq directory (directory-file-name (expand-file-name directory))) (when (file-exists-p directory) - (if recursive - (mapc - (lambda (file) - (if (file-directory-p file) - (delete-directory file recursive) - (delete-file file))) - ;; We do not want to delete "." and "..". - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) + (when recursive + (mapc + (lambda (file) + (if (file-directory-p file) + (delete-directory file recursive) + (delete-file file))) + ;; We do not want to delete "." and "..". + (directory-files directory 'full directory-files-no-dot-files-regexp))) (with-parsed-tramp-file-name directory nil ;; We must also flush the cache of the directory, because diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index fe927bb..f1f722b 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -115,8 +115,8 @@ being the result.") (defmacro tramp--instrument-test-case (verbose &rest body) "Run BODY with `tramp-verbose' equal VERBOSE. Print the the content of the Tramp debug buffer, if BODY does not -eval properly in `should', `should-not' or `should-error'. BODY -shall not contain a timeout." +eval properly in `should' or `should-not'. `should-error' is not +handled properly. BODY shall not contain a timeout." (declare (indent 1) (debug (natnump body))) `(let ((tramp-verbose ,verbose) (tramp-debug-on-error t) @@ -951,7 +951,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (should-not (file-directory-p tmp-name)) ;; Delete non-empty directory. (make-directory tmp-name) + (should (file-directory-p tmp-name)) (write-region "foo" nil (expand-file-name "bla" tmp-name)) + (should (file-exists-p (expand-file-name "bla" tmp-name))) (should-error (delete-directory tmp-name)) (delete-directory tmp-name 'recursive) (should-not (file-directory-p tmp-name)))) commit 36e69bd82a0294b1f51d99a5eaf8e2c7661f7a16 Author: Eli Zaretskii Date: Tue Jul 5 19:33:01 2016 +0300 Fix redisplay with window-start on continuation lines * src/xdisp.c (pos_visible_p): Return false if the window starts after CHARPOS. (compute_window_start_on_continuation_line): Don't return window-start position that is after point in the buffer, as the callers don't expect this to happen, and will generally display an empty window with the cursor in its middle. (Bug#23871) diff --git a/src/xdisp.c b/src/xdisp.c index d05eca1..d5ffb25 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1321,6 +1321,11 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, if (CHARPOS (top) > ZV) SET_TEXT_POS (top, BEGV, BEGV_BYTE); + /* If the top of the window is after CHARPOS, the latter is surely + not visible. */ + if (charpos >= 0 && CHARPOS (top) > charpos) + return visible_p; + /* Compute exact mode line heights. */ if (WINDOW_WANTS_MODELINE_P (w)) w->mode_line_height @@ -15512,12 +15517,14 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, The new window start will be computed, based on W's width, starting from the start of the continued line. It is the start of the - screen line with the minimum distance from the old start W->start. */ + screen line with the minimum distance from the old start W->start, + which is still before point (otherwise point will definitely not + be visible in the window). */ static bool compute_window_start_on_continuation_line (struct window *w) { - struct text_pos pos, start_pos; + struct text_pos pos, start_pos, pos_before_pt; bool window_start_changed_p = false; SET_TEXT_POS_FROM_MARKER (start_pos, w->start); @@ -15545,10 +15552,14 @@ compute_window_start_on_continuation_line (struct window *w) reseat_at_previous_visible_line_start (&it); /* If the line start is "too far" away from the window start, - say it takes too much time to compute a new window start. */ - if (CHARPOS (start_pos) - IT_CHARPOS (it) - /* PXW: Do we need upper bounds here? */ - < WINDOW_TOTAL_LINES (w) * WINDOW_TOTAL_COLS (w)) + say it takes too much time to compute a new window start. + Also, give up if the line start is after point, as in that + case point will not be visible with any window start we + compute. */ + if (IT_CHARPOS (it) <= PT + || (CHARPOS (start_pos) - IT_CHARPOS (it) + /* PXW: Do we need upper bounds here? */ + < WINDOW_TOTAL_LINES (w) * WINDOW_TOTAL_COLS (w))) { int min_distance, distance; @@ -15558,12 +15569,14 @@ compute_window_start_on_continuation_line (struct window *w) decreased, the new window start will be < the old start. So, we're looking for the display line start with the minimum distance from the old window start. */ - pos = it.current.pos; + pos_before_pt = pos = it.current.pos; min_distance = INFINITY; while ((distance = eabs (CHARPOS (start_pos) - IT_CHARPOS (it))), distance < min_distance) { min_distance = distance; + if (CHARPOS (pos) <= PT) + pos_before_pt = pos; pos = it.current.pos; if (it.line_wrap == WORD_WRAP) { @@ -15586,6 +15599,13 @@ compute_window_start_on_continuation_line (struct window *w) move_it_by_lines (&it, 1); } + /* It makes very little sense to make the new window start + after point, as point won't be visible. If that's what + the loop above finds, fall back on the candidate before + or at point that is closest to the old window start. */ + if (CHARPOS (pos) > PT) + pos = pos_before_pt; + /* Set the window start there. */ SET_MARKER_FROM_TEXT_POS (w->start, pos); window_start_changed_p = true; commit c770dbb098a413b84b9f6d5afdc306d6c89c52cd Author: Tino Calancha Date: Wed Jul 6 01:10:22 2016 +0900 Add :expected-result :failed for unfixed bug test * test/lisp/help-fns-tests.el (help-fns-test-bug23887): diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index ba0d8ed..4239a2a 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -77,6 +77,7 @@ Return first line of the output of (describe-function-1 FUNC)." (ert-deftest help-fns-test-bug23887 () "Test for http://debbugs.gnu.org/23887 ." + :expected-result :failed (let ((regexp "an alias for .re-search-forward. in .subr\.el") (result (help-fns-tests--describe-function 'search-forward-regexp))) (should (string-match regexp result))))