emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/native-comp 6487d4a 11/11: Merge remote-tracking branch 'savanna


From: Andrea Corallo
Subject: feature/native-comp 6487d4a 11/11: Merge remote-tracking branch 'savannah/master' into HEAD
Date: Wed, 4 Mar 2020 12:08:33 -0500 (EST)

branch: feature/native-comp
commit 6487d4ac5da92aab4d54b5702bba24a5a1ce8432
Merge: 1f3ba65 cf45e80
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>

    Merge remote-tracking branch 'savannah/master' into HEAD
---
 etc/NEWS                     |   3 ++
 lisp/help-fns.el             | 116 +++++++++++++++++++++++++++++++++++++++++--
 lisp/help.el                 | 108 ----------------------------------------
 lisp/progmodes/elisp-mode.el |  31 +++++++++++-
 lisp/replace.el              |   6 ++-
 lisp/speedbar.el             |   1 +
 lisp/whitespace.el           |  24 +++++----
 src/emacs.c                  |   3 +-
 src/nsfns.m                  |  74 ---------------------------
 src/nsterm.h                 |  22 ++++++--
 src/nsterm.m                 |  46 +++++++----------
 src/timefns.c                |  94 +++++++++++++++++++----------------
 src/xterm.c                  |  10 ++++
 test/src/timefns-tests.el    |   3 ++
 14 files changed, 265 insertions(+), 276 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 7f70d14..fcdf6db 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -96,6 +96,9 @@ shows equivalent key bindings for all commands that have them.
 
 * Changes in Specialized Modes and Packages in Emacs 28.1
 
+** Emacs-Lisp mode
+*** The mode-line now indicates whether we're using lexical or dynamic scoping.
+
 ** Dired
 
 *** State changing VC operations are supported in dired-mode on files
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index e629a40..fad5b03 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -977,7 +977,7 @@ it is displayed along with the global value."
                                    " is a variable defined in `%s'.\n"
                                    (if (eq file-name 'C-source)
                                        "C source code"
-                                     (file-name-nondirectory file-name))))
+                                     (help-fns-short-filename file-name))))
                           (with-current-buffer standard-output
                             (save-excursion
                               (re-search-backward (substitute-command-keys
@@ -1359,7 +1359,7 @@ If FRAME is omitted or nil, use the selected frame."
              (setq file-name (find-lisp-object-file-name f 'defface))
              (when file-name
                (princ (substitute-command-keys "Defined in `"))
-               (princ (file-name-nondirectory file-name))
+               (princ (help-fns-short-filename file-name))
                (princ (substitute-command-keys "'"))
                ;; Make a hyperlink to the library.
                (save-excursion
@@ -1651,7 +1651,7 @@ keymap value."
                       " defined in `%s'.\n\n"
                       (if (eq file-name 'C-source)
                           "C source code"
-                        (file-name-nondirectory file-name))))
+                        (help-fns-short-filename file-name))))
               (save-excursion
                 (re-search-backward (substitute-command-keys
                                      "`\\([^`']+\\)'")
@@ -1667,7 +1667,115 @@ keymap value."
     ;; Cleanup.
     (when used-gentemp
       (makunbound keymap))))
-
+
+;;;###autoload
+(defun describe-mode (&optional buffer)
+  "Display documentation of current major mode and minor modes.
+A brief summary of the minor modes comes first, followed by the
+major mode description.  This is followed by detailed
+descriptions of the minor modes, each on a separate page.
+
+For this to work correctly for a minor mode, the mode's indicator
+variable \(listed in `minor-mode-alist') must also be a function
+whose documentation describes the minor mode.
+
+If called from Lisp with a non-nil BUFFER argument, display
+documentation for the major and minor modes of that buffer."
+  (interactive "@")
+  (unless buffer (setq buffer (current-buffer)))
+  (help-setup-xref (list #'describe-mode buffer)
+                  (called-interactively-p 'interactive))
+  ;; For the sake of help-do-xref and help-xref-go-back,
+  ;; don't switch buffers before calling `help-buffer'.
+  (with-help-window (help-buffer)
+    (with-current-buffer buffer
+      (let (minor-modes)
+       ;; Older packages do not register in minor-mode-list but only in
+       ;; minor-mode-alist.
+       (dolist (x minor-mode-alist)
+         (setq x (car x))
+         (unless (memq x minor-mode-list)
+           (push x minor-mode-list)))
+       ;; Find enabled minor mode we will want to mention.
+       (dolist (mode minor-mode-list)
+         ;; Document a minor mode if it is listed in minor-mode-alist,
+         ;; non-nil, and has a function definition.
+         (let ((fmode (or (get mode :minor-mode-function) mode)))
+           (and (boundp mode) (symbol-value mode)
+                (fboundp fmode)
+                (let ((pretty-minor-mode
+                       (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
+                                         (symbol-name fmode))
+                           (capitalize
+                            (substring (symbol-name fmode)
+                                       0 (match-beginning 0)))
+                         fmode)))
+                  (push (list fmode pretty-minor-mode
+                              (format-mode-line (assq mode minor-mode-alist)))
+                        minor-modes)))))
+       ;; Narrowing is not a minor mode, but its indicator is part of
+       ;; mode-line-modes.
+       (when (buffer-narrowed-p)
+         (push '(narrow-to-region "Narrow" " Narrow") minor-modes))
+       (setq minor-modes
+             (sort minor-modes
+                   (lambda (a b) (string-lessp (cadr a) (cadr b)))))
+       (when minor-modes
+         (princ "Enabled minor modes:\n")
+         (make-local-variable 'help-button-cache)
+         (with-current-buffer standard-output
+           (dolist (mode minor-modes)
+             (let ((mode-function (nth 0 mode))
+                   (pretty-minor-mode (nth 1 mode))
+                   (indicator (nth 2 mode)))
+               (save-excursion
+                 (goto-char (point-max))
+                 (princ "\n\f\n")
+                 (push (point-marker) help-button-cache)
+                 ;; Document the minor modes fully.
+                  (insert-text-button
+                   pretty-minor-mode 'type 'help-function
+                   'help-args (list mode-function)
+                   'button '(t))
+                 (princ (format " minor mode (%s):\n"
+                                (if (zerop (length indicator))
+                                    "no indicator"
+                                  (format "indicator%s"
+                                          indicator))))
+                 (princ (help-split-fundoc (documentation mode-function)
+                                            nil 'doc)))
+               (insert-button pretty-minor-mode
+                              'action (car help-button-cache)
+                              'follow-link t
+                              'help-echo "mouse-2, RET: show full information")
+               (newline)))
+           (forward-line -1)
+           (fill-paragraph nil)
+           (forward-line 1))
+
+         (princ "\n(Information about these minor modes follows the major mode 
info.)\n\n"))
+       ;; Document the major mode.
+       (let ((mode mode-name))
+         (with-current-buffer standard-output
+            (let ((start (point)))
+              (insert (format-mode-line mode nil nil buffer))
+              (add-text-properties start (point) '(face bold)))))
+       (princ " mode")
+       (let* ((mode major-mode)
+              (file-name (find-lisp-object-file-name mode nil)))
+         (when file-name
+           (princ (format-message " defined in `%s'"
+                                   (help-fns-short-filename file-name)))
+           ;; Make a hyperlink to the library.
+           (with-current-buffer standard-output
+             (save-excursion
+               (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
+                                    nil t)
+               (help-xref-button 1 'help-function-def mode file-name)))))
+       (princ ":\n")
+       (princ (help-split-fundoc (documentation major-mode) nil 'doc)))))
+  ;; For the sake of IELM and maybe others
+  nil)
 
 ;;; Replacements for old lib-src/ programs.  Don't seem especially useful.
 
diff --git a/lisp/help.el b/lisp/help.el
index 45cbaad..e40ed47 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -879,114 +879,6 @@ current buffer."
             (princ ", which is ")
            (describe-function-1 defn)))))))
 
-(defun describe-mode (&optional buffer)
-  "Display documentation of current major mode and minor modes.
-A brief summary of the minor modes comes first, followed by the
-major mode description.  This is followed by detailed
-descriptions of the minor modes, each on a separate page.
-
-For this to work correctly for a minor mode, the mode's indicator
-variable \(listed in `minor-mode-alist') must also be a function
-whose documentation describes the minor mode.
-
-If called from Lisp with a non-nil BUFFER argument, display
-documentation for the major and minor modes of that buffer."
-  (interactive "@")
-  (unless buffer (setq buffer (current-buffer)))
-  (help-setup-xref (list #'describe-mode buffer)
-                  (called-interactively-p 'interactive))
-  ;; For the sake of help-do-xref and help-xref-go-back,
-  ;; don't switch buffers before calling `help-buffer'.
-  (with-help-window (help-buffer)
-    (with-current-buffer buffer
-      (let (minor-modes)
-       ;; Older packages do not register in minor-mode-list but only in
-       ;; minor-mode-alist.
-       (dolist (x minor-mode-alist)
-         (setq x (car x))
-         (unless (memq x minor-mode-list)
-           (push x minor-mode-list)))
-       ;; Find enabled minor mode we will want to mention.
-       (dolist (mode minor-mode-list)
-         ;; Document a minor mode if it is listed in minor-mode-alist,
-         ;; non-nil, and has a function definition.
-         (let ((fmode (or (get mode :minor-mode-function) mode)))
-           (and (boundp mode) (symbol-value mode)
-                (fboundp fmode)
-                (let ((pretty-minor-mode
-                       (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
-                                         (symbol-name fmode))
-                           (capitalize
-                            (substring (symbol-name fmode)
-                                       0 (match-beginning 0)))
-                         fmode)))
-                  (push (list fmode pretty-minor-mode
-                              (format-mode-line (assq mode minor-mode-alist)))
-                        minor-modes)))))
-       ;; Narrowing is not a minor mode, but its indicator is part of
-       ;; mode-line-modes.
-       (when (buffer-narrowed-p)
-         (push '(narrow-to-region "Narrow" " Narrow") minor-modes))
-       (setq minor-modes
-             (sort minor-modes
-                   (lambda (a b) (string-lessp (cadr a) (cadr b)))))
-       (when minor-modes
-         (princ "Enabled minor modes:\n")
-         (make-local-variable 'help-button-cache)
-         (with-current-buffer standard-output
-           (dolist (mode minor-modes)
-             (let ((mode-function (nth 0 mode))
-                   (pretty-minor-mode (nth 1 mode))
-                   (indicator (nth 2 mode)))
-               (save-excursion
-                 (goto-char (point-max))
-                 (princ "\n\f\n")
-                 (push (point-marker) help-button-cache)
-                 ;; Document the minor modes fully.
-                  (insert-text-button
-                   pretty-minor-mode 'type 'help-function
-                   'help-args (list mode-function)
-                   'button '(t))
-                 (princ (format " minor mode (%s):\n"
-                                (if (zerop (length indicator))
-                                    "no indicator"
-                                  (format "indicator%s"
-                                          indicator))))
-                 (princ (help-split-fundoc (documentation mode-function)
-                                            nil 'doc)))
-               (insert-button pretty-minor-mode
-                              'action (car help-button-cache)
-                              'follow-link t
-                              'help-echo "mouse-2, RET: show full information")
-               (newline)))
-           (forward-line -1)
-           (fill-paragraph nil)
-           (forward-line 1))
-
-         (princ "\n(Information about these minor modes follows the major mode 
info.)\n\n"))
-       ;; Document the major mode.
-       (let ((mode mode-name))
-         (with-current-buffer standard-output
-            (let ((start (point)))
-              (insert (format-mode-line mode nil nil buffer))
-              (add-text-properties start (point) '(face bold)))))
-       (princ " mode")
-       (let* ((mode major-mode)
-              (file-name (find-lisp-object-file-name mode nil)))
-         (when file-name
-           (princ (format-message " defined in `%s'"
-                                   (file-name-nondirectory file-name)))
-           ;; Make a hyperlink to the library.
-           (with-current-buffer standard-output
-             (save-excursion
-               (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
-                                    nil t)
-               (help-xref-button 1 'help-function-def mode file-name)))))
-       (princ ":\n")
-       (princ (help-split-fundoc (documentation major-mode) nil 'doc)))))
-  ;; For the sake of IELM and maybe others
-  nil)
-
 (defun search-forward-help-for-help ()
   "Search forward \"help window\"."
   (interactive)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 813b628..20ec370 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -231,8 +231,35 @@ Comments in the form will be lost."
           (setq-local electric-pair-text-pairs elisp-pairs)))))
   (remove-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
 
+(defun elisp-enable-lexical-binding (&optional interactive)
+  "Make the current buffer use `lexical-binding'."
+  (interactive "p")
+  (if lexical-binding
+      (when interactive
+        (message "lexical-binding already enabled!")
+        (ding))
+    (when (or (not interactive)
+              (y-or-n-p (format "Enable lexical-binding in this %s? "
+                                (if buffer-file-name "file" "buffer"))))
+      (setq-local lexical-binding t)
+      (add-file-local-variable-prop-line 'lexical-binding t interactive))))
+
+(defvar elisp--dynlex-modeline-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [mode-line mouse-1] 'elisp-enable-lexical-binding)
+    map))
+
 ;;;###autoload
-(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
+(define-derived-mode emacs-lisp-mode prog-mode
+  `("ELisp"
+    (lexical-binding (:propertize "/l"
+                      help-echo "Using lexical-binding mode")
+                     (:propertize "/d"
+                      help-echo "Using old dynamic scoping mode\n\
+mouse-1: Enable lexical-binding mode"
+                     face warning
+                     mouse-face mode-line-highlight
+                      local-map ,elisp--dynlex-modeline-map)))
   "Major mode for editing Lisp code to run in Emacs.
 Commands:
 Delete converts tabs to spaces as it moves back.
@@ -245,7 +272,7 @@ Blank lines separate paragraphs.  Semicolons start comments.
   (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
   (if (boundp 'electric-pair-text-pairs)
       (setq-local electric-pair-text-pairs
-                  (append '((?\` . ?\') (?‘ . ?’))
+                  (append '((?\` . ?\') (?\‘ . ?\’))
                           electric-pair-text-pairs))
     (add-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
   (setq-local electric-quote-string t)
diff --git a/lisp/replace.el b/lisp/replace.el
index a0b0506..168ccf2 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1576,7 +1576,8 @@ See also `multi-occur'."
                                          (and (overlayp boo)
                                               (overlay-buffer boo)))
                                  boo))
-                          bufs))))
+                           bufs)))
+        (source-buffer-default-directory default-directory))
     ;; Handle the case where one of the buffers we're searching is the
     ;; output buffer.  Just rename it.
     (when (member buf-name
@@ -1593,6 +1594,9 @@ See also `multi-occur'."
     (setq occur-buf (get-buffer-create buf-name))
 
     (with-current-buffer occur-buf
+      ;; Make the default-directory of the *Occur* buffer match that of
+      ;; the buffer where the occurences come from
+      (setq default-directory source-buffer-default-directory)
       (if (stringp nlines)
          (fundamental-mode) ;; This is for collect operation.
        (occur-mode))
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index faa0bcc..d8dccfa 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -11,6 +11,7 @@
   "This version of speedbar is incompatible with this version.
 Due to massive API changes (removing the use of the word PATH)
 this version is not backward compatible to 0.14 or earlier.")
+(make-obsolete-variable 'speedbar-incompatible-version nil "28.1")
 
 ;; This file is part of GNU Emacs.
 
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 0137ddc..47434bf 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -2067,16 +2067,7 @@ resultant list will be returned."
        ,@(when (or (memq 'lines      whitespace-active-style)
                    (memq 'lines-tail whitespace-active-style))
            ;; Show "long" lines.
-           `((,(let ((line-column (or whitespace-line-column fill-column)))
-                 (format
-                  
"^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
-                  tab-width
-                  (1- tab-width)
-                  (/ line-column tab-width)
-                  (let ((rem (% line-column tab-width)))
-                    (if (zerop rem)
-                        ""
-                      (format ".\\{%d\\}" rem)))))
+           `((,#'whitespace-lines-regexp
               ,(if (memq 'lines whitespace-active-style)
                    0                    ; whole line
                  2)                     ; line tail
@@ -2177,6 +2168,19 @@ resultant list will be returned."
             (setq status nil)))                  ;; end of buffer
     status))
 
+(defun whitespace-lines-regexp (limit)
+  (re-search-forward
+   (let ((line-column (or whitespace-line-column fill-column)))
+     (format
+      "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
+      tab-width
+      (1- tab-width)
+      (/ line-column tab-width)
+      (let ((rem (% line-column tab-width)))
+        (if (zerop rem)
+            ""
+          (format ".\\{%d\\}" rem)))))
+   limit t))
 
 (defun whitespace-empty-at-bob-regexp (limit)
   "Match spaces at beginning of buffer which do not contain the point at \
diff --git a/src/emacs.c b/src/emacs.c
index b16ffa4..ce1c9ed 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1243,6 +1243,7 @@ main (int argc, char **argv)
   if (! (lc_all && strcmp (lc_all, "C") == 0))
     {
       #ifdef HAVE_NS
+        ns_pool = ns_alloc_autorelease_pool ();
         ns_init_locale ();
       #endif
       setlocale (LC_ALL, "");
@@ -1617,8 +1618,6 @@ Using an Emacs configured with --with-x-toolkit=lucid 
does not have this problem
 #endif
 
 #ifdef HAVE_NS
-  ns_pool = ns_alloc_autorelease_pool ();
-
   if (!noninteractive)
     {
 #ifdef NS_IMPL_COCOA
diff --git a/src/nsfns.m b/src/nsfns.m
index cbde93b..f6e7f4e 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -3012,80 +3012,6 @@ DEFUN ("ns-show-character-palette",
 
    ========================================================================== 
*/
 
-/*
-  Handle arrow/function/control keys and copy/paste/cut in file dialogs.
-  Return YES if handled, NO if not.
- */
-static BOOL
-handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
-{
-  NSString *s;
-  int i;
-  BOOL ret = NO;
-
-  if ([theEvent type] != NSEventTypeKeyDown) return NO;
-  s = [theEvent characters];
-
-  for (i = 0; i < [s length]; ++i)
-    {
-      int ch = (int) [s characterAtIndex: i];
-      switch (ch)
-        {
-        case NSHomeFunctionKey:
-        case NSDownArrowFunctionKey:
-        case NSUpArrowFunctionKey:
-        case NSLeftArrowFunctionKey:
-        case NSRightArrowFunctionKey:
-        case NSPageUpFunctionKey:
-        case NSPageDownFunctionKey:
-        case NSEndFunctionKey:
-          /* Don't send command modified keys, as those are handled in the
-             performKeyEquivalent method of the super class.  */
-          if (! ([theEvent modifierFlags] & NSEventModifierFlagCommand))
-            {
-              [panel sendEvent: theEvent];
-              ret = YES;
-            }
-          break;
-          /* As we don't have the standard key commands for
-             copy/paste/cut/select-all in our edit menu, we must handle
-             them here.  TODO: handle Emacs key bindings for 
copy/cut/select-all
-             here, paste works, because we have that in our Edit menu.
-             I.e. refactor out code in nsterm.m, keyDown: to figure out the
-             correct modifier.  */
-        case 'x': // Cut
-        case 'c': // Copy
-        case 'v': // Paste
-        case 'a': // Select all
-          if ([theEvent modifierFlags] & NSEventModifierFlagCommand)
-            {
-              [NSApp sendAction:
-                       (ch == 'x'
-                        ? @selector(cut:)
-                        : (ch == 'c'
-                           ? @selector(copy:)
-                           : (ch == 'v'
-                              ? @selector(paste:)
-                              : @selector(selectAll:))))
-                             to:nil from:panel];
-              ret = YES;
-            }
-        default:
-          // Send all control keys, as the text field supports C-a, C-f, C-e
-          // C-b and more.
-          if ([theEvent modifierFlags] & NSEventModifierFlagControl)
-            {
-              [panel sendEvent: theEvent];
-              ret = YES;
-            }
-          break;
-        }
-    }
-
-
-  return ret;
-}
-
 @implementation EmacsFileDelegate
 /* --------------------------------------------------------------------------
    Delegate methods for Open/Save panels
diff --git a/src/nsterm.h b/src/nsterm.h
index 7c6197f..db966e1 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -339,6 +339,22 @@ typedef id instancetype;
 #endif
 
 
+/* macOS 10.14 and above cannot draw directly "to the glass" and
+   therefore we draw to an offscreen buffer and swap it in when the
+   toolkit wants to draw the frame. GNUstep and macOS 10.7 and below
+   do not support this method, so we revert to drawing directly to the
+   glass.
+
+   FIXME: Should we make this macOS 10.8+, or macOS 10.14+?  I'm
+   inclined to go with 10.14+ as there have been some reports of funny
+   behaviour on 10.13 and below.  It may be worth adding a variable to
+   allow people in the overlapping region to switch between drawing
+   paths.  */
+#if defined (NS_IMPL_COCOA) && defined (MAC_OS_X_VERSION_10_14)
+#define NS_DRAW_TO_BUFFER 1
+#endif
+
+
 /* ==========================================================================
 
    NSColor, EmacsColor category.
@@ -417,7 +433,7 @@ typedef id instancetype;
    int maximized_width, maximized_height;
    NSWindow *nonfs_window;
    BOOL fs_is_native;
-#ifdef NS_IMPL_COCOA
+#ifdef NS_DRAW_TO_BUFFER
    CGContextRef drawingBuffer;
 #endif
 @public
@@ -460,11 +476,11 @@ typedef id instancetype;
 #endif
 - (int)fullscreenState;
 
-#ifdef NS_IMPL_COCOA
+#ifdef NS_DRAW_TO_BUFFER
 - (void)focusOnDrawingBuffer;
+- (void)createDrawingBuffer;
 #endif
 - (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect;
-- (void)createDrawingBuffer;
 
 /* Non-notification versions of NSView methods. Used for direct calls.  */
 - (void)windowWillEnterFullScreen;
diff --git a/src/nsterm.m b/src/nsterm.m
index 84acb61..8e25614 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -1117,7 +1117,7 @@ ns_update_begin (struct frame *f)
 #endif
 
   ns_updating_frame = f;
-#ifdef NS_IMPL_COCOA
+#ifdef NS_DRAW_TO_BUFFER
   [view focusOnDrawingBuffer];
 #else
   [view lockFocus];
@@ -1139,7 +1139,7 @@ ns_update_end (struct frame *f)
 /*   if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */
   MOUSE_HL_INFO (f)->mouse_face_defer = 0;
 
-#ifdef NS_IMPL_COCOA
+#ifdef NS_DRAW_TO_BUFFER
   [NSGraphicsContext setCurrentContext:nil];
 #else
   block_input ();
@@ -1172,7 +1172,7 @@ ns_focus (struct frame *f, NSRect *r, int n)
     }
 
   if (f != ns_updating_frame)
-#ifdef NS_IMPL_COCOA
+#ifdef NS_DRAW_TO_BUFFER
     [view focusOnDrawingBuffer];
 #else
     {
@@ -1238,20 +1238,6 @@ ns_unfocus (struct frame *f)
 }
 
 
-static void
-ns_clip_to_row (struct window *w, struct glyph_row *row,
-               enum glyph_row_area area, BOOL gc)
-/* --------------------------------------------------------------------------
-     Internal (but parallels other terms): Focus drawing on given row
-   -------------------------------------------------------------------------- 
*/
-{
-  struct frame *f = XFRAME (WINDOW_FRAME (w));
-  NSRect clip_rect = ns_row_rect (w, row, area);
-
-  ns_focus (f, &clip_rect, 1);
-}
-
-
 /* ==========================================================================
 
     Visible bell and beep.
@@ -2089,7 +2075,7 @@ ns_set_appearance (struct frame *f, Lisp_Object 
new_value, Lisp_Object old_value
 {
 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
   EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
-  NSWindow *window = [view window];
+  EmacsWindow *window = (EmacsWindow *)[view window];
 
   NSTRACE ("ns_set_appearance");
 
@@ -2553,7 +2539,7 @@ ns_mouse_position (struct frame **fp, int insist, 
Lisp_Object *bar_window,
   id view;
   NSPoint view_position;
   Lisp_Object frame, tail;
-  struct frame *f;
+  struct frame *f = NULL;
   struct ns_display_info *dpyinfo;
 
   NSTRACE ("ns_mouse_position");
@@ -4005,7 +3991,7 @@ ns_dumpglyphs_stretch (struct glyph_string *s)
 {
   NSRect r[2];
   NSRect glyphRect;
-  int n, i;
+  int n;
   struct face *face;
   NSColor *fgCol, *bgCol;
 
@@ -5389,7 +5375,7 @@ ns_term_init (Lisp_Object display_name)
           }
 
         /* FIXME: Report any errors writing the color file below.  */
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101100
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101100
 #if MAC_OS_X_VERSION_MIN_REQUIRED < 101100
         if ([cl respondsToSelector:@selector(writeToURL:error:)])
 #endif
@@ -7091,8 +7077,10 @@ not_in_argv (NSString *arg)
          from non-native fullscreen, in other circumstances it appears
          to be a noop.  (bug#28872) */
       wr = NSMakeRect (0, 0, neww, newh);
-      [self createDrawingBuffer];
       [view setFrame: wr];
+#ifdef NS_DRAW_TO_BUFFER
+      [self createDrawingBuffer];
+#endif
 
       // To do: consider using [NSNotificationCenter postNotificationName:].
       [self windowDidMove: // Update top/left.
@@ -7393,7 +7381,7 @@ not_in_argv (NSString *arg)
 {
   NSRect r, wr;
   Lisp_Object tem;
-  NSWindow *win;
+  EmacsWindow *win;
   NSColor *col;
   NSString *name;
 
@@ -7430,7 +7418,9 @@ not_in_argv (NSString *arg)
   maximizing_resize = NO;
 #endif
 
+#ifdef NS_DRAW_TO_BUFFER
   [self createDrawingBuffer];
+#endif
 
   win = [[EmacsWindow alloc]
             initWithContentRect: r
@@ -8210,7 +8200,7 @@ not_in_argv (NSString *arg)
 }
 
 
-#ifdef NS_IMPL_COCOA
+#ifdef NS_DRAW_TO_BUFFER
 - (void)createDrawingBuffer
   /* Create and store a new CGGraphicsContext for Emacs to draw into.
 
@@ -8268,7 +8258,7 @@ not_in_argv (NSString *arg)
       expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
     }
 }
-#endif /* NS_IMPL_COCOA */
+#endif /* NS_DRAW_TO_BUFFER */
 
 
 - (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect
@@ -8277,7 +8267,7 @@ not_in_argv (NSString *arg)
   NSTRACE_RECT ("Source", srcRect);
   NSTRACE_RECT ("Destination", dstRect);
 
-#ifdef NS_IMPL_COCOA
+#ifdef NS_DRAW_TO_BUFFER
   CGImageRef copy;
   NSRect frame = [self frame];
   NSAffineTransform *setOrigin = [NSAffineTransform transform];
@@ -8317,7 +8307,7 @@ not_in_argv (NSString *arg)
 }
 
 
-#ifdef NS_IMPL_COCOA
+#ifdef NS_DRAW_TO_BUFFER
 - (BOOL)wantsUpdateLayer
 {
     return YES;
@@ -8812,7 +8802,7 @@ not_in_argv (NSString *arg)
 
 - (void)setAppearance
 {
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
   struct frame *f = ((EmacsView *)[self delegate])->emacsframe;
   NSAppearance *appearance = nil;
 
diff --git a/src/timefns.c b/src/timefns.c
index 46f9193..0aa8775 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -569,25 +569,27 @@ timespec_to_lisp (struct timespec t)
 static double
 frac_to_double (Lisp_Object numerator, Lisp_Object denominator)
 {
-  intmax_t intmax_numerator;
-  if (FASTER_TIMEFNS && EQ (denominator, make_fixnum (1))
-      && integer_to_intmax (numerator, &intmax_numerator))
-    return intmax_numerator;
+  intmax_t intmax_numerator, intmax_denominator;
+  if (FASTER_TIMEFNS
+      && integer_to_intmax (numerator, &intmax_numerator)
+      && integer_to_intmax (denominator, &intmax_denominator)
+      && ! INT_DIVIDE_OVERFLOW (intmax_numerator, intmax_denominator)
+      && intmax_numerator % intmax_denominator == 0)
+    return intmax_numerator / intmax_denominator;
 
   mpz_t const *n = bignum_integer (&mpz[0], numerator);
   mpz_t const *d = bignum_integer (&mpz[1], denominator);
-  ptrdiff_t nbits = mpz_sizeinbase (*n, 2);
-  ptrdiff_t dbits = mpz_sizeinbase (*d, 2);
-  eassume (0 < nbits);
-  eassume (0 < dbits);
-  ptrdiff_t ndig = (nbits + LOG2_FLT_RADIX - 1) / LOG2_FLT_RADIX;
-  ptrdiff_t ddig = (dbits + LOG2_FLT_RADIX - 1) / LOG2_FLT_RADIX;
+  ptrdiff_t ndig = mpz_sizeinbase (*n, FLT_RADIX);
+  ptrdiff_t ddig = mpz_sizeinbase (*d, FLT_RADIX);
+
+  if (FASTER_TIMEFNS && ndig <= DBL_MANT_DIG && ddig <= DBL_MANT_DIG)
+    return mpz_get_d (*n) / mpz_get_d (*d);
 
   /* Scale with SCALE when doing integer division.  That is, compute
      (N * FLT_RADIX**SCALE) / D [or, if SCALE is negative, N / (D *
      FLT_RADIX**-SCALE)] as a bignum, convert the bignum to double,
      then divide the double by FLT_RADIX**SCALE.  */
-  ptrdiff_t scale = ddig - ndig + DBL_MANT_DIG + 1;
+  ptrdiff_t scale = ddig - ndig + DBL_MANT_DIG;
   if (scale < 0)
     {
       mpz_mul_2exp (mpz[1], *d, - (scale * LOG2_FLT_RADIX));
@@ -615,7 +617,7 @@ frac_to_double (Lisp_Object numerator, Lisp_Object 
denominator)
      round to the nearest integer; otherwise, it is less than
      FLT_RADIX ** (DBL_MANT_DIG + 1) and round it to the nearest
      multiple of FLT_RADIX.  Break ties to even.  */
-  if (mpz_sizeinbase (*q, 2) < DBL_MANT_DIG * LOG2_FLT_RADIX)
+  if (mpz_sizeinbase (*q, FLT_RADIX) <= DBL_MANT_DIG)
     {
       /* Converting to double will use the whole quotient so add 1 to
         its absolute value as per round-to-even; i.e., if the doubled
@@ -739,44 +741,48 @@ decode_time_components (enum timeform form,
   /* Normalize out-of-range lower-order components by carrying
      each overflow into the next higher-order component.  */
   us += ps / 1000000 - (ps % 1000000 < 0);
-  mpz_set_intmax (mpz[0], us / 1000000 - (us % 1000000 < 0));
-  mpz_add (mpz[0], mpz[0], *bignum_integer (&mpz[1], low));
-  mpz_addmul_ui (mpz[0], *bignum_integer (&mpz[1], high), 1 << LO_TIME_BITS);
+  mpz_t *s = &mpz[1];
+  mpz_set_intmax (*s, us / 1000000 - (us % 1000000 < 0));
+  mpz_add (*s, *s, *bignum_integer (&mpz[0], low));
+  mpz_addmul_ui (*s, *bignum_integer (&mpz[0], high), 1 << LO_TIME_BITS);
   ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0);
   us = us % 1000000 + 1000000 * (us % 1000000 < 0);
 
-  if (result)
+  Lisp_Object hz;
+  switch (form)
     {
-      switch (form)
-       {
-       case TIMEFORM_HI_LO:
-         /* Floats and nil were handled above, so it was an integer.  */
-         result->hz = make_fixnum (1);
-         break;
-
-       case TIMEFORM_HI_LO_US:
-         mpz_mul_ui (mpz[0], mpz[0], 1000000);
-         mpz_add_ui (mpz[0], mpz[0], us);
-         result->hz = make_fixnum (1000000);
-         break;
-
-       case TIMEFORM_HI_LO_US_PS:
-         mpz_mul_ui (mpz[0], mpz[0], 1000000);
-         mpz_add_ui (mpz[0], mpz[0], us);
-         mpz_mul_ui (mpz[0], mpz[0], 1000000);
-         mpz_add_ui (mpz[0], mpz[0], ps);
-         result->hz = trillion;
-         break;
-
-       default:
-         eassume (false);
-       }
-      result->ticks = make_integer_mpz ();
+    case TIMEFORM_HI_LO:
+      /* Floats and nil were handled above, so it was an integer.  */
+      mpz_swap (mpz[0], *s);
+      hz = make_fixnum (1);
+      break;
+
+    case TIMEFORM_HI_LO_US:
+      mpz_set_ui (mpz[0], us);
+      mpz_addmul_ui (mpz[0], *s, 1000000);
+      hz = make_fixnum (1000000);
+      break;
+
+    case TIMEFORM_HI_LO_US_PS:
+      {
+       #if FASTER_TIMEFNS && TRILLION <= ULONG_MAX
+         unsigned long i = us;
+         mpz_set_ui (mpz[0], i * 1000000 + ps);
+         mpz_addmul_ui (mpz[0], *s, TRILLION);
+       #else
+         intmax_t i = us;
+         mpz_set_intmax (mpz[0], i * 1000000 + ps);
+         mpz_addmul (mpz[0], *s, ztrillion);
+       #endif
+       hz = trillion;
+      }
+      break;
+
+    default:
+      eassume (false);
     }
-  else
-    *dresult = mpz_get_d (mpz[0]) + (us * 1e6L + ps) / 1e12L;
 
-  return 0;
+  return decode_ticks_hz (make_integer_mpz (), hz, result, dresult);
 }
 
 enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 };
diff --git a/src/xterm.c b/src/xterm.c
index 21d99f0..5d229e4 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -4790,6 +4790,16 @@ x_detect_focus_change (struct x_display_info *dpyinfo, 
struct frame *frame,
 
     case FocusIn:
     case FocusOut:
+      /* Ignore transient focus events from hotkeys, window manager
+         gadgets, and other odd sources.  Some buggy window managers
+         (e.g., Muffin 4.2.4) send FocusIn events of this type without
+         corresponding FocusOut events even when some other window
+         really has focus, and these kinds of focus event don't
+         correspond to real user input changes.  GTK+ uses the same
+         filtering. */
+      if (event->xfocus.mode == NotifyGrab ||
+          event->xfocus.mode == NotifyUngrab)
+        return;
       x_focus_changed (event->type,
                       (event->xfocus.detail == NotifyPointer ?
                        FOCUS_IMPLICIT : FOCUS_EXPLICIT),
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index 3967590..b24d443 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -220,6 +220,9 @@ a fixed place on the right and are padded on the left."
              '(23752 27217))))
 
 (ert-deftest float-time-precision ()
+  (should (= (float-time '(0 1 0 4025)) 1.000000004025))
+  (should (= (float-time '(1000000004025 . 1000000000000)) 1.000000004025))
+
   (should (< 0 (float-time '(1 . 10000000000))))
   (should (< (float-time '(-1 . 10000000000)) 0))
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]