commit dc95cb8c2d646468186c5b379bd6d138c1ec1d1c (HEAD, refs/remotes/origin/master) Author: Andy Moreton Date: Thu Oct 29 08:46:43 2015 +0100 Handle negative coordinates in ‘x_calc_absolute_position’ * src/w32term.c (x_calc_absolute_position): Find display origin to allow for negative coordinates. diff --git a/src/w32term.c b/src/w32term.c index 8317867..f764e25 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -5913,16 +5913,49 @@ x_calc_absolute_position (struct frame *f) top_bottom_borders_height = 32; } + /* With multiple monitors, we can legitimately get negative + coordinates (for monitors above or to the left of the primary + monitor). Find the display origin to ensure negative positions + are computed correctly (Bug#21173). */ + int display_left = 0; + int display_top = 0; + if (flags & (XNegative | YNegative)) + { + Lisp_Object list; + + list = Fw32_display_monitor_attributes_list (Qnil); + while (CONSP (list)) + { + Lisp_Object attributes = CAR(list); + Lisp_Object geometry; + Lisp_Object monitor_left, monitor_top; + + list = CDR(list); + + geometry = Fassoc (Qgeometry, attributes); + if (!NILP (geometry)) + { + monitor_left = Fnth (make_number (1), geometry); + monitor_top = Fnth (make_number (2), geometry); + + display_left = min (display_left, XINT (monitor_left)); + display_top = min (display_top, XINT (monitor_top)); + } + } + } + /* Treat negative positions as relative to the rightmost bottommost position that fits on the screen. */ if (flags & XNegative) f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f)) + + display_left - FRAME_PIXEL_WIDTH (f) + f->left_pos - (left_right_borders_width - 1)); if (flags & YNegative) f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) + + display_top - FRAME_PIXEL_HEIGHT (f) + f->top_pos - (top_bottom_borders_height - 1)); commit d7a67c5a2fe63b6f087d6cae24c8f3b3c09eb57a Author: Stefan Monnier Date: Wed Oct 28 22:18:47 2015 -0400 (internal--syntax-propertize): Save match-data here (bug#21766) * lisp/emacs-lisp/syntax.el (internal--syntax-propertize): Save match-data. * lisp/simple.el (delete-trailing-whitespace): Undo last change. diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 95ed775..d446a2c 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -328,7 +328,7 @@ The return value is a function suitable for `syntax-propertize-function'." ;;; Link syntax-propertize with syntax.c. (defvar syntax-propertize-chunks - ;; We're not sure how far we'll go. In my tests, using chunks of 20000 + ;; We're not sure how far we'll go. In my tests, using chunks of 2000 ;; brings to overhead to something negligible. Passing ‘charpos’ directly ;; also works (basically works line-by-line) but results in an overhead which ;; I thought was a bit too high (like around 50%). @@ -336,7 +336,8 @@ The return value is a function suitable for `syntax-propertize-function'." (defun internal--syntax-propertize (charpos) ;; FIXME: Called directly from C. - (syntax-propertize (min (+ syntax-propertize-chunks charpos) (point-max)))) + (save-match-data + (syntax-propertize (min (+ syntax-propertize-chunks charpos) (point-max))))) ;;; Incrementally compute and memoize parser state. @@ -376,12 +377,10 @@ This function should move the cursor back to some syntactically safe point (where the PPSS is equivalent to nil).") (make-obsolete-variable 'syntax-begin-function nil "25.1") -(defvar syntax-ppss-cache nil +(defvar-local syntax-ppss-cache nil "List of (POS . PPSS) pairs, in decreasing POS order.") -(make-variable-buffer-local 'syntax-ppss-cache) -(defvar syntax-ppss-last nil +(defvar-local syntax-ppss-last nil "Cache of (LAST-POS . LAST-PPSS).") -(make-variable-buffer-local 'syntax-ppss-last) (defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache) (defun syntax-ppss-flush-cache (beg &rest ignored) diff --git a/lisp/simple.el b/lisp/simple.el index f6c580f..338a060 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -609,8 +609,7 @@ buffer if the variable `delete-trailing-lines' is non-nil." (start (or start (point-min)))) (goto-char start) (while (re-search-forward "\\s-$" end-marker t) - (save-match-data - (skip-syntax-backward "-" (line-beginning-position))) + (skip-syntax-backward "-" (line-beginning-position)) ;; Don't delete formfeeds, even if they are considered whitespace. (if (looking-at-p ".*\f") (goto-char (match-end 0))) commit ffa41ad2a02dbd1202d71a08bac34831f25662d0 Author: Dmitry Gutov Date: Thu Oct 29 03:00:50 2015 +0200 Don't require default-directory to end with a slash * doc/lispref/files.texi (Magic File Names): Document the change in unhandled-file-name-directory. * lisp/url/url-handlers.el (url-handler-unhandled-file-name-directory): Update accordingly. * src/buffer.c (default-directory): Update the docsting. * src/fileio.c (unhandled-file-name-directory): Default to calling `file-name-as-directory' (http://lists.gnu.org/archive/html/emacs-devel/2015-10/msg02294.html). diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 65a97a4..6083433 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3082,7 +3082,7 @@ making connections when they don't exist. @defun unhandled-file-name-directory filename This function returns the name of a directory that is not magic. It -uses the directory part of @var{filename} if that is not magic. For a +turns @var{filename} into a directory name if that is not magic. For a magic file name, it invokes the file name handler, which therefore decides what value to return. If @var{filename} is not accessible from a local process, then the file name handler should indicate it by diff --git a/etc/NEWS b/etc/NEWS index 47a4bae..512b491 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1034,6 +1034,11 @@ The new behavior is compatible with Common Lisp and with XEmacs. This change does not affect Lisp code intended to be portable to Emacs 24.2 and earlier, which did not support unary ‘/’. ++++ +** The `default-directory' value doesn't have to end slash. To make +that happen, `unhandled-file-name-directory' now defaults to calling +`file-name-as-directory'. + * Lisp Changes in Emacs 25.1 diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 845195e..a5d9f37 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -223,7 +223,7 @@ the arguments that would have been passed to OPERATION." ;; which really stands for "/". ;; FIXME: maybe we should check that the host part is "" or "localhost" ;; or some name that represents the local host? - (or (file-name-directory (url-filename url)) "/") + (or (file-name-as-directory (url-filename url)) "/") ;; All other URLs are not expected to be directly accessible from ;; a local process. nil))) diff --git a/src/buffer.c b/src/buffer.c index 380a7af..91e42dc 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5739,7 +5739,7 @@ visual lines rather than logical lines. See the documentation of DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory), Qstringp, - doc: /* Name of default directory of current buffer. Should end with slash. + doc: /* Name of default directory of current buffer. To interactively change the default directory, use command `cd'. */); DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function), diff --git a/src/fileio.c b/src/fileio.c index 428093b..6cda1e3 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -450,7 +450,7 @@ DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, A `directly usable' directory name is one that may be used without the intervention of any file handler. If FILENAME is a directly usable file itself, return -(file-name-directory FILENAME). +(file-name-as-directory FILENAME). If FILENAME refers to a file which is not accessible from a local process, then this should return nil. The `call-process' and `start-process' functions use this function to @@ -469,7 +469,7 @@ get a current directory to run processes in. */) return STRINGP (handled_name) ? handled_name : Qnil; } - return Ffile_name_directory (filename); + return Ffile_name_as_directory (filename); } /* Maximum number of bytes that DST will be longer than SRC commit 42eb249ebd48b8df80357be41364b23a7af4fcf0 Author: Artur Malabarba Date: Thu Oct 29 00:22:50 2015 +0000 * lisp/isearch.el: Delete some outdated comments diff --git a/lisp/isearch.el b/lisp/isearch.el index 915255b..e9eec01 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -31,11 +31,7 @@ ;; is completed. It uses a recursive-edit to behave this way. ;; The key bindings active within isearch-mode are defined below in -;; `isearch-mode-map' which is given bindings close to the default -;; characters of the original isearch.el. With `isearch-mode', -;; however, you can bind multi-character keys and it should be easier -;; to add new commands. One bug though: keys with meta-prefix cannot -;; be longer than two chars. Also see minibuffer-local-isearch-map +;; `isearch-mode-map'. Also see minibuffer-local-isearch-map ;; for bindings active during `isearch-edit-string'. ;; isearch-mode should work even if you switch windows with the mouse, commit 2765945d616f9661dd0aa641f4ecd328dd8768d7 Author: Vibhav Pant Date: Wed Oct 28 22:37:34 2015 +0530 Fix eshell/clear not working if the output has a small line count * lisp/eshell/esh-mode.el: (eshell/clear): Use (window-size) as the number of newlines to be inserted. This fixes the issue where eshell/clear wouldn't work if the prompt was not at the bottom of the window, and the output wasn't too long. diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 3df820d..9cc9d34 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -877,9 +877,8 @@ If SCROLLBACK is non-nil, clear the scrollback contents." (interactive) (if scrollback (eshell/clear-scrollback) - (let ((number-newlines (count-lines (window-start) (point)))) - (insert (make-string number-newlines ?\n)) - (eshell-send-input)))) + (insert (make-string (window-size) ?\n)) + (eshell-send-input))) (defun eshell/clear-scrollback () "Clear the scrollback content of the eshell window." commit d8f82d8199198aa0133aa4dea75643f13e551d26 Author: Artur Malabarba Date: Wed Oct 28 21:12:47 2015 +0000 ; * etc/NEWS: Document `search-default-regexp-mode' diff --git a/etc/NEWS b/etc/NEWS index f5b06f9..47a4bae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -115,6 +115,8 @@ frames. ** New doc command `describe-symbol'. Works for functions, vars, faces, etc... +** New user option `search-default-regexp-mode' specifies the default mode for isearch + ** `isearch' and `query-replace' now perform character folding in matches. This is analogous to case-folding, but applies between Unicode characters and their ASCII counterparts. This means many characters commit db31a883252e17af4386598c52d42ed81db56973 Author: Stefan Monnier Date: Wed Oct 28 14:01:18 2015 -0400 * lisp/files.el (write-file): Use vc-refresh-state. diff --git a/lisp/files.el b/lisp/files.el index d0e3e68..b25994c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4041,7 +4041,7 @@ Interactively, confirmation is required unless you supply a prefix argument." (save-buffer) ;; It's likely that the VC status at the new location is different from ;; the one at the old location. - (vc-find-file-hook)) + (vc-refresh-state)) (defun file-extended-attributes (filename) "Return an alist of extended attributes of file FILENAME. commit 0cbe7a23326323df541ef80678429612e6a2f542 Author: Stefan Monnier Date: Wed Oct 28 14:00:59 2015 -0400 * lisp/autorevert.el (auto-revert-handler): Use vc-refresh-state. diff --git a/lisp/autorevert.el b/lisp/autorevert.el index f0c12d2..18b8161 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -688,7 +688,7 @@ This is an internal function used by Auto-Revert Mode." ;; `preserve-modes' avoids changing the (minor) modes. But we do ;; want to reset the mode for VC, so we do it manually. (when (or revert auto-revert-check-vc-info) - (vc-find-file-hook)))) + (vc-refresh-state)))) (defun auto-revert-tail-handler (size) (let ((modified (buffer-modified-p)) commit dfa2e4a6e6cbf64df9031858c473b0e0ab1a00d3 Author: Stefan Monnier Date: Wed Oct 28 14:00:24 2015 -0400 * lisp/vc/pcvs.el (cvs-revert-if-needed): Use vc-refresh-state. diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index f6a9e08..3fdee10 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -2312,7 +2312,7 @@ this file, or a list of arguments to send to the program." (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes) ;; `preserve-modes' avoids changing the (minor) modes. But we ;; do want to reset the mode for VC, so we do it explicitly. - (vc-find-file-hook) + (vc-refresh-state) (when (eq (cvs-fileinfo->type fileinfo) 'CONFLICT) (smerge-start-session)))))))) commit d5ee655c1710a62e01513fd20256a7cf35d52167 Author: Stefan Monnier Date: Wed Oct 28 13:59:42 2015 -0400 * lisp/emacs-lisp/macroexp.el: Tweak macroexp-if optimizations (macroexp-unprogn): Make sure we never return an empty list. (macroexp-if): Remove unused (and unsafe) optimization. Optimize (if A T (if B T E)) into (if (or A B) T E) instead, which does occur occasionally. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 8bf49b0..8983454 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -322,8 +322,9 @@ definitions to shadow the loaded ones for use in file byte-compilation." (if (cdr exps) `(progn ,@exps) (car exps))) (defun macroexp-unprogn (exp) - "Turn EXP into a list of expressions to execute in sequence." - (if (eq (car-safe exp) 'progn) (cdr exp) (list exp))) + "Turn EXP into a list of expressions to execute in sequence. +Never returns an empty list." + (if (eq (car-safe exp) 'progn) (or (cdr exp) '(nil)) (list exp))) (defun macroexp-let* (bindings exp) "Return an expression equivalent to `(let* ,bindings ,exp)." @@ -333,22 +334,33 @@ definitions to shadow the loaded ones for use in file byte-compilation." (t `(let* ,bindings ,exp)))) (defun macroexp-if (test then else) - "Return an expression equivalent to `(if ,test ,then ,else)." + "Return an expression equivalent to `(if ,TEST ,THEN ,ELSE)." (cond ((eq (car-safe else) 'if) - (if (equal test (nth 1 else)) - ;; Doing a test a second time: get rid of the redundancy. - `(if ,test ,then ,@(nthcdr 3 else)) - `(cond (,test ,then) - (,(nth 1 else) ,(nth 2 else)) - (t ,@(nthcdr 3 else))))) + (cond + ;; Drop this optimization: It's unsafe (it assumes that `test' is + ;; pure, or at least idempotent), and it's not used even a single + ;; time while compiling Emacs's sources. + ;;((equal test (nth 1 else)) + ;; ;; Doing a test a second time: get rid of the redundancy. + ;; (message "macroexp-if: sharing 'test' %S" test) + ;; `(if ,test ,then ,@(nthcdr 3 else))) + ((equal then (nth 2 else)) + ;; (message "macroexp-if: sharing 'then' %S" then) + `(if (or ,test ,(nth 1 else)) ,then ,@(nthcdr 3 else))) + ((equal (macroexp-unprogn then) (nthcdr 3 else)) + ;; (message "macroexp-if: sharing 'then' with not %S" then) + `(if (or ,test (not ,(nth 1 else))) + ,then ,@(macroexp-unprogn (nth 2 else)))) + (t + `(cond (,test ,@(macroexp-unprogn then)) + (,(nth 1 else) ,@(macroexp-unprogn (nth 2 else))) + (t ,@(nthcdr 3 else)))))) ((eq (car-safe else) 'cond) - `(cond (,test ,then) - ;; Doing a test a second time: get rid of the redundancy, as above. - ,@(remove (assoc test else) (cdr else)))) + `(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else))) ;; Invert the test if that lets us reduce the depth of the tree. ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then)) - (t `(if ,test ,then ,else)))) + (t `(if ,test ,then ,@(macroexp-unprogn else))))) (defmacro macroexp-let2 (test sym exp &rest body) "Evaluate BODY with SYM bound to an expression for EXP's value. commit 1f02cbea8b489ed7676110431aa36ad5abc47d9b Author: Juanma Barranquero Date: Wed Oct 28 09:55:25 2015 +0100 Fix bug#21766 and add test * lisp/simple.el (delete-trailing-whitespace): Save match data when calling `skip-syntax-backward'. * test/automated/simple-test.el (simple-delete-trailing-whitespace): New test. diff --git a/lisp/simple.el b/lisp/simple.el index 338a060..f6c580f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -609,7 +609,8 @@ buffer if the variable `delete-trailing-lines' is non-nil." (start (or start (point-min)))) (goto-char start) (while (re-search-forward "\\s-$" end-marker t) - (skip-syntax-backward "-" (line-beginning-position)) + (save-match-data + (skip-syntax-backward "-" (line-beginning-position))) ;; Don't delete formfeeds, even if they are considered whitespace. (if (looking-at-p ".*\f") (goto-char (match-end 0))) diff --git a/test/automated/simple-test.el b/test/automated/simple-test.el index 8da575d..5bfb746 100644 --- a/test/automated/simple-test.el +++ b/test/automated/simple-test.el @@ -180,5 +180,27 @@ (should (= x 2))) (remove-hook 'post-self-insert-hook inc)))) + +;;; `delete-trailing-whitespace' +(ert-deftest simple-delete-trailing-whitespace () + "Test bug#21766: delete-whitespace sometimes deletes non-whitespace." + (defvar python-indent-guess-indent-offset) ; to avoid a warning + (let ((python (featurep 'python)) + (python-indent-guess-indent-offset nil) + (delete-trailing-lines t)) + (unwind-protect + (with-temp-buffer + (python-mode) + (insert (concat "query = \"\"\"WITH filtered AS \n" + "WHERE \n" + "\"\"\".format(fv_)\n" + "\n" + "\n")) + (delete-trailing-whitespace) + (should (equal (count-lines (point-min) (point-max)) 3))) + ;; Let's clean up if running interactive + (unless (or noninteractive python) + (unload-feature 'python))))) + (provide 'simple-test) ;;; simple-test.el ends here commit 785c0d8326a5f82ca3b69d8e90ebb6fc5731e6d3 Author: Artur Malabarba Date: Wed Oct 28 17:06:27 2015 +0000 * doc/lispref/sequences.texi (Sequence Functions): Fix typo diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 730dac1..84a7c32 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -575,7 +575,7 @@ element of @var{sequence}. The returned value is a list. @defun seq-mapn function &rest sequences This function returns the result of applying @var{function} to each element of @var{sequences}. The arity of @var{function} must match -the number of sequences. Mapping stops at the shrotest sequence, and +the number of sequences. Mapping stops at the shortest sequence, and the returned value is a list. @example commit 45cdacb09890121bdcf07279b2fe5bc6a52fa22c Author: Paul Eggert Date: Wed Oct 28 09:10:17 2015 -0700 * src/dispnew.c (init_display): Simplify overflow checking. diff --git a/src/dispnew.c b/src/dispnew.c index 18eed3c..9164076 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6097,8 +6097,8 @@ init_display (void) change. It's not clear what better we could do. The rest of the code assumes that (width + 2) * height * sizeof (struct glyph) does not overflow and does not exceed PTRDIFF_MAX or SIZE_MAX. */ - if (INT_ADD_RANGE_OVERFLOW (width, 2, INT_MIN, INT_MAX) - || INT_MULTIPLY_RANGE_OVERFLOW (width + 2, height, INT_MIN, INT_MAX) + if (INT_ADD_OVERFLOW (width, 2) + || INT_MULTIPLY_OVERFLOW (width + 2, height) || (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct glyph) < (width + 2) * height)) fatal ("screen size %dx%d too big", width, height); commit 020e8505575390ef464b8058d07cee9b161827b1 Author: Artur Malabarba Date: Wed Oct 28 15:50:17 2015 +0000 * lisp/character-fold.el (character-fold-to-regexp): Fix case where string ends in space diff --git a/lisp/character-fold.el b/lisp/character-fold.el index 521e98b..223a2cd 100644 --- a/lisp/character-fold.el +++ b/lisp/character-fold.el @@ -101,6 +101,13 @@ equiv)) "Used for folding characters of the same group during search.") +(defun character-fold--make-space-string (n) + "Return a string that matches N spaces." + (format "\\(?:%s\\|%s\\)" + (make-string n ?\s) + (apply #'concat + (make-list n (or (aref character-fold-table ?\s) " "))))) + ;;;###autoload (defun character-fold-to-regexp (string &optional _lax) "Return a regexp matching anything that character-folds into STRING. @@ -121,18 +128,16 @@ regexp) and other characters are `regexp-quote'd." (setq spaces (1+ spaces)) nil) ((> spaces 0) - (prog1 (format "\\(?:%s\\|%s\\)%s" - (make-string spaces ?\s) - (apply #'concat - (make-list spaces - (or (aref character-fold-table ?\s) " "))) + (prog1 (concat (character-fold--make-space-string spaces) (or (aref character-fold-table c) (regexp-quote (string c)))) (setq spaces 0))) (t (or (aref character-fold-table c) (regexp-quote (string c)))))) (setq chars (cdr chars)))) - (apply #'concat out))) + (concat (apply #'concat out) + (when (> spaces 0) + (character-fold--make-space-string spaces))))) ;;; Commands provided for completeness. commit 7dfe247864f12b93b906edb5934af3c356acade4 Author: Artur Malabarba Date: Wed Oct 28 14:27:39 2015 +0000 * lisp/emacs-lisp/seq.el (seq-mapn): New function * doc/lispref/sequences.texi (Sequence Functions): Document seq-mapn diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 8ecae7b..730dac1 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -572,6 +572,24 @@ element of @var{sequence}. The returned value is a list. @end example @end defun +@defun seq-mapn function &rest sequences + This function returns the result of applying @var{function} to each +element of @var{sequences}. The arity of @var{function} must match +the number of sequences. Mapping stops at the shrotest sequence, and +the returned value is a list. + +@example +@group +(seq-mapn #'+ '(2 4 6) '(20 40 60)) +@result{} (22 44 66) +@end group +@group +(seq-mapn #'concat '("moskito" "bite") ["bee" "sting"]) +@result{} ("moskitobee" "bitesting") +@end group +@end example +@end defun + @defun seq-filter predicate sequence @cindex filtering sequences This function returns a list of all the elements in @var{sequence} diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index d0c2d24..6826509 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 2.1 +;; Version: 2.2 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org @@ -148,6 +148,21 @@ if positive or too small if negative)." (cl-defmethod seq-map (function (sequence sequence)) (mapcar function sequence)) +(cl-defgeneric seq-mapn (function sequence &rest sequences) + "Like `seq-map' but FUNCTION is mapped over all SEQUENCES. +The arity of FUNCTION must match the number of SEQUENCES, and the +mapping stops on the shortest sequence. +Return a list of the results. + +\(fn FUNCTION SEQUENCES...)" + (let ((result nil) + (sequences (seq-map (lambda (s) (seq-into s 'list)) + (cons sequence sequences)))) + (while (not (memq nil sequences)) + (push (apply function (seq-map #'car sequences)) result) + (setq sequences (seq-map #'cdr sequences))) + (nreverse result))) + (cl-defgeneric seq-drop (sequence n) "Remove the first N elements of SEQUENCE and return the result. The result is a sequence of the same type as SEQUENCE. commit 4281f722dd782d91f4b2bbd03834cbd1d944db5c Author: Artur Malabarba Date: Wed Oct 28 15:03:47 2015 +0000 * lisp/character-fold.el: Make compatible with lax-whitespace (character-fold-to-regexp): Rework internals to play nice with lax-whitespacing. When the user types a space, we want to match the table entry for ?\s, which is generally a regexp like "[ ...]". However, the `search-spaces-regexp' variable doesn't "see" spaces inside these regexp constructs, so we need to use "\\( \\|[ ...]\\)" instead (to manually expose a space). Furthermore, the lax search engine acts on a bunch of spaces, not on individual spaces, so if the string contains sequential spaces like " ", we need to keep them grouped together like this: "\\( \\|[ ...][ ...]\\)". diff --git a/lisp/character-fold.el b/lisp/character-fold.el index 6b242f4..521e98b 100644 --- a/lisp/character-fold.el +++ b/lisp/character-fold.el @@ -107,10 +107,32 @@ Any character in STRING that has an entry in `character-fold-table' is replaced with that entry (which is a regexp) and other characters are `regexp-quote'd." - (apply #'concat - (mapcar (lambda (c) (or (aref character-fold-table c) - (regexp-quote (string c)))) - string))) + (let* ((spaces 0) + (chars (mapcar #'identity string)) + (out chars)) + ;; When the user types a space, we want to match the table entry, + ;; but we also want the ?\s to be visible to `search-spaces-regexp'. + ;; See commit message for a longer description. + (while chars + (let ((c (car chars))) + (setcar chars + (cond + ((eq c ?\s) + (setq spaces (1+ spaces)) + nil) + ((> spaces 0) + (prog1 (format "\\(?:%s\\|%s\\)%s" + (make-string spaces ?\s) + (apply #'concat + (make-list spaces + (or (aref character-fold-table ?\s) " "))) + (or (aref character-fold-table c) + (regexp-quote (string c)))) + (setq spaces 0))) + (t (or (aref character-fold-table c) + (regexp-quote (string c)))))) + (setq chars (cdr chars)))) + (apply #'concat out))) ;;; Commands provided for completeness. commit faace42f8a4c8f53f629419ba89a5196d62ee006 Author: Artur Malabarba Date: Wed Oct 28 12:01:39 2015 +0000 * lisp/isearch.el: Refactor momentary messages (isearch--momentary-message): New function. (isearch-toggle-lax-whitespace, isearch-toggle-case-fold) (isearch-toggle-invisible): Use it. diff --git a/lisp/isearch.el b/lisp/isearch.el index 1c545de..915255b 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1532,48 +1532,46 @@ The command then executes BODY and updates the isearch prompt." (setq isearch-regexp (not isearch-regexp)) (if isearch-regexp (setq isearch-regexp-function nil))) +(defun isearch--momentary-message (string) + "Print STRING at the end of the isearch prompt for 1 second" + (let ((message-log-max nil)) + (message "%s%s [%s]" + (isearch-message-prefix nil isearch-nonincremental) + isearch-message + string)) + (sit-for 1)) + (isearch-define-mode-toggle lax-whitespace " " nil "In ordinary search, toggles the value of the variable `isearch-lax-whitespace'. In regexp search, toggles the value of the variable `isearch-regexp-lax-whitespace'." - (if isearch-regexp - (setq isearch-regexp-lax-whitespace (not isearch-regexp-lax-whitespace)) - (setq isearch-lax-whitespace (not isearch-lax-whitespace))) - (let ((message-log-max nil)) - (message "%s%s [%s]" - (isearch-message-prefix nil isearch-nonincremental) - isearch-message - (if (if isearch-regexp - isearch-regexp-lax-whitespace - isearch-lax-whitespace) - "match spaces loosely" - "match spaces literally"))) - (sit-for 1)) + (isearch--momentary-message + (if (if isearch-regexp + (setq isearch-regexp-lax-whitespace (not isearch-regexp-lax-whitespace)) + (setq isearch-lax-whitespace (not isearch-lax-whitespace))) + "match spaces loosely" + "match spaces literally"))) (isearch-define-mode-toggle case-fold "c" nil "Toggles the value of the variable `isearch-case-fold-search'." - (setq isearch-case-fold-search - (if isearch-case-fold-search nil 'yes)) - (let ((message-log-max nil)) - (message "%s%s [case %ssensitive]" - (isearch-message-prefix nil isearch-nonincremental) - isearch-message - (if isearch-case-fold-search "in" ""))) - (sit-for 1)) + (isearch--momentary-message + (if (setq isearch-case-fold-search + (if isearch-case-fold-search nil 'yes)) + "case insensitive" + "case sensitive"))) (isearch-define-mode-toggle invisible "i" nil "This determines whether to search inside invisible text or not. Toggles the variable `isearch-invisible' between values nil and a non-nil value of the option `search-invisible' \(or `open' if `search-invisible' is nil)." - (setq isearch-invisible - (if isearch-invisible nil (or search-invisible 'open))) - (let ((message-log-max nil)) - (message "%s%s [match %svisible text]" - (isearch-message-prefix nil isearch-nonincremental) - isearch-message - (if isearch-invisible "in" ""))) - (sit-for 1)) + "match %svisible text" + (isearch--momentary-message + (if (setq isearch-invisible + (if isearch-invisible + nil (or search-invisible 'open))) + "match invisible text" + "match visible text"))) ;; Word search commit 12c0edb7555613aecfd27610601f137be252b804 Author: Artur Malabarba Date: Wed Oct 28 11:43:52 2015 +0000 * lisp/isearch.el: Define all toggles with `isearch-define-mode-toggle' (isearch-define-mode-toggle): New macro. (isearch-toggle-invisible): Renamed to `isearch-define-mode-toggle'. (isearch-toggle-case-fold, isearch-toggle-invisible) (isearch-toggle-regexp, isearch-toggle-lax-whitespace): Define with `isearch-define-mode-toggle'. diff --git a/lisp/isearch.el b/lisp/isearch.el index a1ce4f1..1c545de 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -235,7 +235,7 @@ If a function, use that function as an `isearch-regexp-function'. Example functions are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp' \(`\\[isearch-toggle-symbol]'), and `character-fold-to-regexp' \(`\\[isearch-toggle-character-fold]')." - ;; :type is set below by `isearch-specify-regexp-function'. + ;; :type is set below by `isearch-define-mode-toggle'. :type '(choice (const :tag "Literal search" nil) (const :tag "Regexp search" t) (function :tag "Other")) @@ -520,11 +520,7 @@ This is like `describe-bindings', but displays only Isearch keys." (put 'isearch-edit-string :advertised-binding "\M-se") (define-key map "\M-se" 'isearch-edit-string) - (define-key map "\M-sc" 'isearch-toggle-case-fold) - (define-key map "\M-si" 'isearch-toggle-invisible) - (define-key map "\M-sr" 'isearch-toggle-regexp) - (define-key map "\M-s " 'isearch-toggle-lax-whitespace) - ;; More toggles defined by `isearch-specify-regexp-function'. + ;; More toggles defined by `isearch-define-mode-toggle'. (define-key map [?\M-%] 'isearch-query-replace) (define-key map [?\C-\M-%] 'isearch-query-replace-regexp) @@ -1494,50 +1490,52 @@ Use `isearch-exit' to quit without signaling." (interactive) (isearch-repeat 'backward)) -(defun isearch-toggle-regexp () - "Toggle regexp searching on or off." - ;; The status stack is left unchanged. - (interactive) - (setq isearch-regexp (not isearch-regexp)) - (if isearch-regexp (setq isearch-regexp-function nil)) - (setq isearch-success t isearch-adjusted t) - (isearch-update)) - + ;;; Toggles for `isearch-regexp-function' and `search-default-regexp-mode'. -(defmacro isearch-specify-regexp-function (mode function key) - "Define a search MODE in which `isearch-regexp-function' is set to FUNCTION. -Define a command called `isearch-toggle-MODE' and bind it to -`isearch-mode-map' under `M-s KEY'. -Also set the `isearch-message-prefix' property of FUNCTION." +(defmacro isearch-define-mode-toggle (mode key function &optional docstring &rest body) + "Define a command called `isearch-toggle-MODE' and bind it to `M-s KEY'. +The first line of the docstring is auto-generated, the remainder +may be provided in DOCSTRING. +If FUNCTION is a symbol, this command first toggles the value of +`isearch-regexp-function' between nil and FUNCTION. Also set the +`isearch-message-prefix' property of FUNCTION. +The command then executes BODY and updates the isearch prompt." + (declare (indent defun)) (let ((command-name (intern (format "isearch-toggle-%s" mode)))) `(progn (defun ,command-name () - ,(format "Toggle %s searching on or off." mode) + ,(format "Toggle %s searching on or off.%s" mode + (if docstring (concat "\n" docstring) "")) (interactive) - (setq isearch-regexp-function - (unless (eq isearch-regexp-function #',function) - #',function)) - (when isearch-regexp-function (setq isearch-regexp nil)) + ,@(when function + `((setq isearch-regexp-function + (unless (eq isearch-regexp-function #',function) + #',function)) + (when isearch-regexp-function (setq isearch-regexp nil)))) + ,@body (setq isearch-success t isearch-adjusted t) (isearch-update)) (define-key isearch-mode-map ,(concat "\M-s" key) #',command-name) - (put ',function 'isearch-message-prefix ,(format "%s " mode)) - (cl-callf (lambda (types) (cons 'choice - (cons '(const :tag ,(capitalize (format "%s search" mode)) ,function) - (cdr types)))) - (get 'search-default-regexp-mode 'custom-type))))) - -(isearch-specify-regexp-function word word-search-regexp "w") -(isearch-specify-regexp-function symbol isearch-symbol-regexp "_") -(isearch-specify-regexp-function character-fold character-fold-to-regexp "'") + ,@(when (symbolp function) + `((put ',function 'isearch-message-prefix ,(format "%s " mode)) + (cl-callf (lambda (types) (cons 'choice + (cons '(const :tag ,(capitalize (format "%s search" mode)) ,function) + (cdr types)))) + (get 'search-default-regexp-mode 'custom-type))))))) + +(isearch-define-mode-toggle word "w" word-search-regexp) +(isearch-define-mode-toggle symbol "_" isearch-symbol-regexp) +(isearch-define-mode-toggle character-fold "'" character-fold-to-regexp) (put 'character-fold-to-regexp 'isearch-message-prefix "char-fold ") -(defun isearch-toggle-lax-whitespace () - "Toggle whitespace matching in searching on or off. -In ordinary search, toggles the value of the variable +(isearch-define-mode-toggle regexp "r" nil nil + (setq isearch-regexp (not isearch-regexp)) + (if isearch-regexp (setq isearch-regexp-function nil))) + +(isearch-define-mode-toggle lax-whitespace " " nil + "In ordinary search, toggles the value of the variable `isearch-lax-whitespace'. In regexp search, toggles the value of the variable `isearch-regexp-lax-whitespace'." - (interactive) (if isearch-regexp (setq isearch-regexp-lax-whitespace (not isearch-regexp-lax-whitespace)) (setq isearch-lax-whitespace (not isearch-lax-whitespace))) @@ -1550,14 +1548,10 @@ value of the variable `isearch-regexp-lax-whitespace'." isearch-lax-whitespace) "match spaces loosely" "match spaces literally"))) - (setq isearch-success t isearch-adjusted t) - (sit-for 1) - (isearch-update)) + (sit-for 1)) -(defun isearch-toggle-case-fold () - "Toggle case folding in searching on or off. -Toggles the value of the variable `isearch-case-fold-search'." - (interactive) +(isearch-define-mode-toggle case-fold "c" nil + "Toggles the value of the variable `isearch-case-fold-search'." (setq isearch-case-fold-search (if isearch-case-fold-search nil 'yes)) (let ((message-log-max nil)) @@ -1565,26 +1559,21 @@ Toggles the value of the variable `isearch-case-fold-search'." (isearch-message-prefix nil isearch-nonincremental) isearch-message (if isearch-case-fold-search "in" ""))) - (setq isearch-success t isearch-adjusted t) - (sit-for 1) - (isearch-update)) + (sit-for 1)) -(defun isearch-toggle-invisible () - "Toggle searching in invisible text on or off. +(isearch-define-mode-toggle invisible "i" nil + "This determines whether to search inside invisible text or not. Toggles the variable `isearch-invisible' between values nil and a non-nil value of the option `search-invisible' \(or `open' if `search-invisible' is nil)." - (interactive) (setq isearch-invisible - (if isearch-invisible nil (or search-invisible 'open))) + (if isearch-invisible nil (or search-invisible 'open))) (let ((message-log-max nil)) (message "%s%s [match %svisible text]" - (isearch-message-prefix nil isearch-nonincremental) - isearch-message - (if isearch-invisible "in" ""))) - (setq isearch-success t isearch-adjusted t) - (sit-for 1) - (isearch-update)) + (isearch-message-prefix nil isearch-nonincremental) + isearch-message + (if isearch-invisible "in" ""))) + (sit-for 1)) ;; Word search commit 9fd61a5aa2961d18ae00700bcbb527e5a643f3a2 Author: Michael Albinus Date: Wed Oct 28 15:31:40 2015 +0100 Avoid using `add-to-list' on a let-local var in tramp-smb.el * lisp/net/tramp-compat.el (tramp-compat-delete-dups): New defun. * lisp/net/tramp-smb.el (tramp-smb-handle-directory-files): Use it. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 7157ac2..c571028 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -592,6 +592,16 @@ and replace a sub-expression, e.g. (unless (fboundp 'format-message) (defalias 'format-message 'format)) +;; `delete-dups' does not exist in XEmacs 21.4. +(if (fboundp 'delete-dups) + (defalias 'tramp-compat-delete-dups 'delete-dups) + (defun tramp-compat-delete-dups (list) + "Destructively remove `equal' duplicates from LIST. +Store the result in LIST and return it. LIST must be a proper list. +Of several `equal' occurrences of an element in LIST, the first +one is kept." + (cl-delete-duplicates list '(:test equal :from-end) nil))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 5910d1f..c956795 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -649,8 +649,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (directory &optional full match nosort) "Like `directory-files' for Tramp files." (let ((result (mapcar 'directory-file-name - (file-name-all-completions "" directory))) - res) + (file-name-all-completions "" directory)))) ;; Discriminate with regexp. (when match (setq result @@ -666,8 +665,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Sort them if necessary. (unless nosort (setq result (sort result 'string-lessp))) ;; Remove double entries. - (dolist (elt result res) - (add-to-list 'res elt 'append)))) + (tramp-compat-delete-dups result))) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." commit 1e2ed2687ad35d7a3efee1ef1d482d595eb0879f Merge: e69f777 e5ff0e6 Author: Anders Lindgren Date: Wed Oct 28 12:22:44 2015 +0100 Merge branch 'master' of /Volumes/HD2/build/emacs-git-ssh commit e5ff0e67ccb5c32ff7685f8e3c6792af7c611bbb Merge: cc587a3 e1d0eef Author: Anders Lindgren Date: Wed Oct 28 12:17:33 2015 +0100 Merge branch 'master' of ssh://git.sv.gnu.org/srv/git/emacs commit e69f7770611d85e130806763a46db7e212bc952f Merge: 0392e24 cc587a3 Author: Anders Lindgren Date: Wed Oct 28 12:13:18 2015 +0100 Merge branch 'master' of /Volumes/HD2/build/emacs-git-ssh commit e1d0eefae83d691372455afffeb471ce6dcb8345 Author: Michael Albinus Date: Wed Oct 28 12:12:51 2015 +0100 Revert 692bce5b9eccfae19ae2a5a23a9ccd8d6bf86076 * lisp/net/tramp-smb.el (tramp-smb-handle-directory-files): Revert 692bce5b9eccfae19ae2a5a23a9ccd8d6bf86076, `delete-dups' does not exist in XEmacs 21.4. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index c0a6b6a..5910d1f 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -649,7 +649,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (directory &optional full match nosort) "Like `directory-files' for Tramp files." (let ((result (mapcar 'directory-file-name - (file-name-all-completions "" directory)))) + (file-name-all-completions "" directory))) + res) ;; Discriminate with regexp. (when match (setq result @@ -664,7 +665,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." result))) ;; Sort them if necessary. (unless nosort (setq result (sort result 'string-lessp))) - (delete-dups result))) + ;; Remove double entries. + (dolist (elt result res) + (add-to-list 'res elt 'append)))) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." commit 0392e241b844487261d4dfcccc9a442793e0a868 Author: Anders Lindgren Date: Wed Oct 28 12:11:46 2015 +0100 Fixed OS X startup crash. Input events started to arrive before ns_term_init() was finished. Solved by blocking input. This also seems to correct the "You can't open the application "Emacs" because it may be damaged or incomplete" error issued when double-clicking on the Emacs application. * nsterm.m (ns_constrain_all_frames, ns_init_term): Block input. * nsterm.m (ns_send_appdefined, EmacsApp): Trace output. diff --git a/src/nsterm.m b/src/nsterm.m index e5eb8ca..be86061 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -844,6 +844,8 @@ ns_constrain_all_frames (void) NSTRACE ("ns_constrain_all_frames"); + block_input (); + FOR_EACH_FRAME (tail, frame) { struct frame *f = XFRAME (frame); @@ -855,6 +857,8 @@ ns_constrain_all_frames (void) display:NO]; } } + + unblock_input (); } @@ -3635,7 +3639,7 @@ ns_send_appdefined (int value) recognize and take as a command to halt the event loop. -------------------------------------------------------------------------- */ { - /*NSTRACE ("ns_send_appdefined"); */ + NSTRACE ("ns_send_appdefined"); #ifdef NS_IMPL_GNUSTEP // GNUstep needs postEvent to happen on the main thread. @@ -4529,6 +4533,8 @@ ns_term_init (Lisp_Object display_name) if (ns_initialized) return x_display_list; ns_initialized = 1; + block_input (); + NSTRACE ("ns_term_init"); [outerpool release]; @@ -4768,6 +4774,8 @@ ns_term_init (Lisp_Object display_name) NSTRACE_MSG ("ns_term_init done"); + unblock_input (); + return dpyinfo; } @@ -4803,6 +4811,8 @@ ns_term_shutdown (int sig) - (id)init { + NSTRACE ("[EmacsApp init]"); + if ((self = [super init])) { #ifdef NS_IMPL_COCOA @@ -4819,6 +4829,8 @@ ns_term_shutdown (int sig) #ifdef NS_IMPL_COCOA - (void)run { + NSTRACE ("[EmacsApp run]"); + #ifndef NSAppKitVersionNumber10_9 #define NSAppKitVersionNumber10_9 1265 #endif @@ -4855,6 +4867,8 @@ ns_term_shutdown (int sig) - (void)stop: (id)sender { + NSTRACE ("[EmacsApp stop]"); + shouldKeepRunning = NO; // Stop possible dialog also. Noop if no dialog present. // The file dialog still leaks 7k - 10k on 10.9 though. @@ -4864,6 +4878,8 @@ ns_term_shutdown (int sig) - (void)logNotification: (NSNotification *)notification { + NSTRACE ("[EmacsApp logNotification]"); + const char *name = [[notification name] UTF8String]; if (!strstr (name, "Update") && !strstr (name, "NSMenu") && !strstr (name, "WindowNumber")) @@ -4880,7 +4896,7 @@ ns_term_shutdown (int sig) int type = [theEvent type]; NSWindow *window = [theEvent window]; -/* NSTRACE ("sendEvent"); */ + NSTRACE ("[EmacsApp sendEvent]"); /*fprintf (stderr, "received event of type %d\t%d\n", type);*/ #ifdef NS_IMPL_GNUSTEP @@ -4987,6 +5003,8 @@ ns_term_shutdown (int sig) - (void)newFrame: (id)sender { + NSTRACE ("[EmacsApp newFrame]"); + struct frame *emacsframe = SELECTED_FRAME (); NSEvent *theEvent = [NSApp currentEvent]; @@ -5002,6 +5020,8 @@ ns_term_shutdown (int sig) /* Open a file (used by below, after going into queue read by ns_read_socket) */ - (BOOL) openFile: (NSString *)fileName { + NSTRACE ("[EmacsApp openFile]"); + struct frame *emacsframe = SELECTED_FRAME (); NSEvent *theEvent = [NSApp currentEvent]; @@ -5030,7 +5050,8 @@ ns_term_shutdown (int sig) When application is loaded, terminate event loop in ns_term_init -------------------------------------------------------------------------- */ { - NSTRACE ("applicationDidFinishLaunching"); + NSTRACE ("[EmacsApp applicationDidFinishLaunching]"); + #ifdef NS_IMPL_GNUSTEP ((EmacsApp *)self)->applicationDidFinishLaunchingCalled = YES; #endif @@ -5079,6 +5100,8 @@ ns_term_shutdown (int sig) - (void) terminate: (id)sender { + NSTRACE ("[EmacsApp terminate]"); + struct frame *emacsframe = SELECTED_FRAME (); if (!emacs_event) @@ -5115,6 +5138,8 @@ runAlertPanel(NSString *title, - (NSApplicationTerminateReply)applicationShouldTerminate: (id)sender { + NSTRACE ("[EmacsApp applicationShouldTerminate]"); + bool ret; if (NILP (ns_confirm_quit)) // || ns_shutdown_properly --> TO DO @@ -5194,11 +5219,13 @@ not_in_argv (NSString *arg) /* TODO: these may help w/IO switching btwn terminal and NSApp */ - (void)applicationWillBecomeActive: (NSNotification *)notification { + NSTRACE ("[EmacsApp applicationWillBecomeActive]"); //ns_app_active=YES; } + - (void)applicationDidBecomeActive: (NSNotification *)notification { - NSTRACE ("applicationDidBecomeActive"); + NSTRACE ("[EmacsApp applicationDidBecomeActive]"); #ifdef NS_IMPL_GNUSTEP if (! applicationDidFinishLaunchingCalled) @@ -5212,6 +5239,8 @@ not_in_argv (NSString *arg) } - (void)applicationDidResignActive: (NSNotification *)notification { + NSTRACE ("[EmacsApp applicationDidResignActive]"); + //ns_app_active=NO; ns_send_appdefined (-1); } commit cc587a3539612d250d222363b18d15258e33f82a Merge: 590449f 64c2bfb Author: Anders Lindgren Date: Wed Oct 28 12:09:51 2015 +0100 Merge branch 'master' of ssh://git.sv.gnu.org/srv/git/emacs commit 64c2bfbc4f5daba2ee55acb58a2929070a846b6e Author: Artur Malabarba Date: Wed Oct 28 11:07:41 2015 +0000 * src/process.c (Fget_buffer_process): Improve docstring Document the fact that it doesn't return dead processes. diff --git a/src/process.c b/src/process.c index dc93b86..ed1d59d 100644 --- a/src/process.c +++ b/src/process.c @@ -7176,8 +7176,10 @@ setup_process_coding_systems (Lisp_Object process) } DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, - doc: /* Return the (or a) process associated with BUFFER. -BUFFER may be a buffer or the name of one. */) + doc: /* Return the (or a) live process associated with BUFFER. +BUFFER may be a buffer or the name of one. +Return nil if all processes associated with BUFFER have been +deleted or killed. */) (register Lisp_Object buffer) { #ifdef subprocesses commit 590449f3d87f8f43eb0a852233e8945ecbe1c6aa Author: Anders Lindgren Date: Wed Oct 28 12:06:39 2015 +0100 Fix incorrect NextStep tool-bar-mode -- wrong number of rows in frame. * nsterm.h (struct ns_output): New flag, in_animation. * nsfns.m (Fx_create_frame): Initialize in_animation flag. * nsmenu.m (free_frame_tool_bar, update_frame_tool_bar): Set in_animation flag around call to "setVisible". Set new tool bar height before call to setVisible. * nsterm.m (x_set_window_size): Don't call [view setRow: andColumns:] as this fools the subsequent call to updateFrameSize from performing the real resize. (windowDidResize): Don't update anything when in_animation is non-zero. Trace output. * nsmenu.m (free_frame_tool_bar, update_frame_tool_bar) (EmacsToolbar): * nsterm.m (x_set_window_size, updateFrameSize) ([EmacsView setRows: andColumns:]) diff --git a/src/nsfns.m b/src/nsfns.m index 1ed3e23..c243444 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1298,6 +1298,8 @@ This function is an internal primitive--use `make-frame' instead. */) = [NSCursor arrowCursor]; f->output_data.ns->current_pointer = f->output_data.ns->text_cursor; + f->output_data.ns->in_animation = NO; + [[EmacsView alloc] initFrameFromEmacs: f]; x_icon (f, parms); diff --git a/src/nsmenu.m b/src/nsmenu.m index 2ef1223..ddc5dc2 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -998,10 +998,20 @@ free_frame_tool_bar (struct frame *f) -------------------------------------------------------------------------- */ { EmacsView *view = FRAME_NS_VIEW (f); + + NSTRACE ("free_frame_tool_bar"); + block_input (); view->wait_for_tool_bar = NO; - [[view toolbar] setVisible: NO]; + FRAME_TOOLBAR_HEIGHT (f) = 0; + + /* Note: This trigger an animation, which calls windowDidResize + repeatedly. */ + f->output_data.ns->in_animation = 1; + [[view toolbar] setVisible: NO]; + f->output_data.ns->in_animation = 0; + unblock_input (); } @@ -1017,6 +1027,8 @@ update_frame_tool_bar (struct frame *f) EmacsToolbar *toolbar = [view toolbar]; int oldh; + NSTRACE ("update_frame_tool_bar"); + if (view == nil || toolbar == nil) return; block_input (); @@ -1096,7 +1108,11 @@ update_frame_tool_bar (struct frame *f) } if (![toolbar isVisible]) + { + f->output_data.ns->in_animation = 1; [toolbar setVisible: YES]; + f->output_data.ns->in_animation = 0; + } #ifdef NS_IMPL_COCOA if ([toolbar changed]) @@ -1150,6 +1166,8 @@ update_frame_tool_bar (struct frame *f) - initForView: (EmacsView *)view withIdentifier: (NSString *)identifier { + NSTRACE ("[EmacsToolbar initForView: withIdentifier:]"); + self = [super initWithIdentifier: identifier]; emacsView = view; [self setDisplayMode: NSToolbarDisplayModeIconOnly]; @@ -1164,6 +1182,8 @@ update_frame_tool_bar (struct frame *f) - (void)dealloc { + NSTRACE ("[EmacsToolbar dealloc]"); + [prevIdentifiers release]; [activeIdentifiers release]; [identifierToItem release]; @@ -1172,6 +1192,8 @@ update_frame_tool_bar (struct frame *f) - (void) clearActive { + NSTRACE ("[EmacsToolbar clearActive]"); + [prevIdentifiers release]; prevIdentifiers = [activeIdentifiers copy]; [activeIdentifiers removeAllObjects]; @@ -1181,6 +1203,8 @@ update_frame_tool_bar (struct frame *f) - (void) clearAll { + NSTRACE ("[EmacsToolbar clearAll]"); + [self clearActive]; while ([[self items] count] > 0) [self removeItemAtIndex: 0]; @@ -1188,6 +1212,8 @@ update_frame_tool_bar (struct frame *f) - (BOOL) changed { + NSTRACE ("[EmacsToolbar changed]"); + return [activeIdentifiers isEqualToArray: prevIdentifiers] && enablement == prevEnablement ? NO : YES; } @@ -1198,6 +1224,8 @@ update_frame_tool_bar (struct frame *f) helpText: (const char *)help enabled: (BOOL)enabled { + NSTRACE ("[EmacsToolbar addDisplayItemWithImage: ...]"); + /* 1) come up w/identifier */ NSString *identifier = [NSString stringWithFormat: @"%lu", (unsigned long)[img hash]]; @@ -1231,6 +1259,7 @@ update_frame_tool_bar (struct frame *f) all items to enabled state (for some reason). */ - (void)validateVisibleItems { + NSTRACE ("[EmacsToolbar validateVisibleItems]"); } @@ -1240,12 +1269,16 @@ update_frame_tool_bar (struct frame *f) itemForItemIdentifier: (NSString *)itemIdentifier willBeInsertedIntoToolbar: (BOOL)flag { + NSTRACE ("[EmacsToolbar toolbar: ...]"); + /* look up NSToolbarItem by identifier and return... */ return [identifierToItem objectForKey: itemIdentifier]; } - (NSArray *)toolbarDefaultItemIdentifiers: (NSToolbar *)toolbar { + NSTRACE ("[EmacsToolbar toolbarDefaultItemIdentifiers:]"); + /* return entire set.. */ return activeIdentifiers; } @@ -1253,6 +1286,8 @@ update_frame_tool_bar (struct frame *f) /* for configuration palette (not yet supported) */ - (NSArray *)toolbarAllowedItemIdentifiers: (NSToolbar *)toolbar { + NSTRACE ("[EmacsToolbar toolbarAllowedItemIdentifiers:]"); + /* return entire set... */ return activeIdentifiers; //return [identifierToItem allKeys]; diff --git a/src/nsterm.h b/src/nsterm.h index 8d52dc6..3fb8cfc 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -65,9 +65,12 @@ typedef float EmacsCGFloat; ========================================================================== */ -/* Uncomment the following line to enable trace. */ +/* Uncomment the following line to enable trace. -/* #define NSTRACE_ENABLED 1 */ + Hint: keep the trailing whitespace -- the version control system + will reject accidental commits. */ + +/* #define NSTRACE_ENABLED 1 */ /* Print a call tree containing all annotated functions. @@ -913,6 +916,9 @@ struct ns_output /* Non-zero if we are zooming (maximizing) the frame. */ int zooming; + + /* Non-zero if we are doing an animation, e.g. toggling the tool bar. */ + int in_animation; }; /* this dummy decl needed to support TTYs */ diff --git a/src/nsterm.m b/src/nsterm.m index e5eb8ca..ba205f5 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1497,7 +1497,7 @@ x_set_window_size (struct frame *f, if (view == nil) return; - NSTRACE_RECT ("input", wr); + NSTRACE_RECT ("current", wr); /*fprintf (stderr, "\tsetWindowSize: %d x %d, pixelwise %d, font size %d x %d\n", width, height, pixelwise, FRAME_COLUMN_WIDTH (f), FRAME_LINE_HEIGHT (f));*/ @@ -1559,7 +1559,6 @@ x_set_window_size (struct frame *f, make_number (FRAME_NS_TITLEBAR_HEIGHT (f)), make_number (FRAME_TOOLBAR_HEIGHT (f)))); - [view setRows: rows andColumns: cols]; NSTRACE_RECT ("setFrame", wr); [window setFrame: wr display: YES]; @@ -6142,6 +6141,8 @@ not_in_argv (NSString *arg) NSTRACE ("updateFrameSize"); NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh)); NSTRACE_RECT ("Original frame", wr); + NSTRACE_MSG ("Original columns: %d", cols); + NSTRACE_MSG ("Original rows: %d", rows); if (! [self isFullscreen]) { @@ -6158,13 +6159,19 @@ not_in_argv (NSString *arg) if (wait_for_tool_bar) { if (FRAME_TOOLBAR_HEIGHT (emacsframe) == 0) - return; + { + NSTRACE_MSG ("Waiting for toolbar"); + return; + } wait_for_tool_bar = NO; } neww = (int)wr.size.width - emacsframe->border_width; newh = (int)wr.size.height - extra; + NSTRACE_SIZE ("New size", NSMakeSize (neww, newh)); + NSTRACE_MSG ("tool_bar_height: %d", emacsframe->tool_bar_height); + cols = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (emacsframe, neww); rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (emacsframe, newh); @@ -6174,6 +6181,9 @@ not_in_argv (NSString *arg) if (rows < MINHEIGHT) rows = MINHEIGHT; + NSTRACE_MSG ("New columns: %d", cols); + NSTRACE_MSG ("New rows: %d", rows); + if (oldr != rows || oldc != cols || neww != oldw || newh != oldh) { NSView *view = FRAME_NS_VIEW (emacsframe); @@ -6191,6 +6201,10 @@ not_in_argv (NSString *arg) [view setFrame: wr]; [self windowDidMove:nil]; // Update top/left. } + else + { + NSTRACE_MSG ("No change"); + } } - (NSSize)windowWillResize: (NSWindow *)sender toSize: (NSSize)frameSize @@ -6299,6 +6313,12 @@ not_in_argv (NSString *arg) { NSTRACE ("windowDidResize"); + if (emacsframe->output_data.ns->in_animation) + { + NSTRACE_MSG ("Ignored (in animation)"); + return; + } + if (! [self fsIsNative]) { NSWindow *theWindow = [notification object]; @@ -7396,6 +7416,7 @@ not_in_argv (NSString *arg) - (void) setRows: (int) r andColumns: (int) c { + NSTRACE ("[EmacsView setRows:%d andColumns:%d]", r, c); rows = r; cols = c; } commit 61b63f460ddfb443e2575e4fa7e7714b17579659 Author: Nicolas Petton Date: Wed Oct 28 09:54:00 2015 +0100 * lisp/emacs-lisp/thunk.el (thunk-delay): Fix the macro. diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el index d07b257..0c5816a 100644 --- a/lisp/emacs-lisp/thunk.el +++ b/lisp/emacs-lisp/thunk.el @@ -57,8 +57,8 @@ ,forced (unless ,forced (setf ,val (progn ,@body)) - (setf ,forced t))) - ,val)))) + (setf ,forced t)) + ,val))))) (defun thunk-force (delayed) "Force the evaluation of DELAYED.