commit 7ea7e26ab1976b7534f7c573107adfa74defee22 (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Wed Jun 2 10:13:58 2021 +0200 Move point in dired buffers when handling a list of files * lisp/dired-aux.el (dired-create-files): Advance point to the current file (bug#8015). diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index a1dda3f5a2..3a721cd4d9 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1963,6 +1963,9 @@ or with the current marker character if MARKER-CHAR is t." (let (to overwrite-query overwrite-backup-query) ; for dired-handle-overwrite (dolist (from fn-list) + ;; Position point on the current file -- this is useful if + ;; handling a number of files to show where we're working at. + (dired-goto-file from) (setq to (funcall name-constructor from)) (if (equal to from) (progn commit 16793dc35a5be4d05e3fa42ea8cf6aa1e67f1dc9 Author: Alex Bochannek Date: Wed Jun 2 07:41:25 2021 +0200 Add new user option to Gnus to allow `#' to toggle * doc/misc/gnus.texi (Marking Groups, Setting Process Marks): Mention the new variable. * lisp/gnus/gnus-group.el (gnus-group-make-menu-bar): Update menu. (gnus-group-mark-group): Support the variable. (gnus-group-mark-update): New command. (gnus-group-unmark-group, gnus-group-mark-region): Pass in new parameter. * lisp/gnus/gnus-sum.el (gnus-summary-make-menu-bar): Update menu. (gnus-summary-mark-as-processable): Use the variable. * lisp/gnus/gnus-topic.el (gnus-topic-mark-topic): (bug#48683). * lisp/gnus/gnus-topic.el (gnus-topic-mark-topic): Use the variable. * lisp/gnus/gnus.el (gnus-process-mark-toggle): New user option. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 7d6fa4cb5c..11bcfc16ae 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -2583,7 +2583,9 @@ with the process mark and then execute the command. @itemx M m @kindex M m @r{(Group)} @findex gnus-group-mark-group -Set the mark on the current group (@code{gnus-group-mark-group}). +Set the mark on the current group (@code{gnus-group-mark-group}).@* +If @code{gnus-process-mark-toggle} is non-@code{nil}, toggle the +existing process mark for the current group. @item M-# @kindex M-# @r{(Group)} @@ -4043,7 +4045,9 @@ Toggle hiding empty topics @findex gnus-topic-mark-topic Mark all groups in the current topic with the process mark (@code{gnus-topic-mark-topic}). This command works recursively on -sub-topics unless given a prefix. +sub-topics unless given a prefix.@* +If @code{gnus-process-mark-toggle} is non-@code{nil}, toggle the +existing process mark for the current topic. @item T M-# @kindex T M-# @r{(Topic)} @@ -6618,13 +6622,15 @@ articles into the cache. For more information, @kindex M P p @r{(Summary)} @findex gnus-summary-mark-as-processable Mark the current article with the process mark -(@code{gnus-summary-mark-as-processable}). -@findex gnus-summary-unmark-as-processable +(@code{gnus-summary-mark-as-processable}).@* +If @code{gnus-process-mark-toggle} is non-@code{nil}, toggle the +existing process mark for the current article. @item M P u @itemx M-# @kindex M P u @r{(Summary)} @kindex M-# @r{(Summary)} +@findex gnus-summary-unmark-as-processable Remove the process mark, if any, from the current article (@code{gnus-summary-unmark-as-processable}). @@ -10568,7 +10574,9 @@ Pick the article or thread on the current line entire thread when used at the first article of the thread. Otherwise, it selects just the article. If given a numerical prefix, go to that thread or article and pick it. (The line number is normally displayed -at the beginning of the summary pick lines.) +at the beginning of the summary pick lines.) If +@code{gnus-process-mark-toggle} is non-@code{nil}, this key will +unpick an already picked article. @item @key{SPC} @kindex SPC @r{(Pick)} diff --git a/etc/NEWS b/etc/NEWS index d0f903ffa6..3658f7fcd5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -835,6 +835,11 @@ tags to be considered as well. ** Gnus ++++ +*** New user option 'gnus-process-mark-toggle'. +If non-nil, the `#' command in the Group and Summary buffers will +toggle instead of setting the process mark. + +++ *** New user option 'gnus-registry-register-all'. If non-nil (the default), create registry entries for all messages. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 8c62c9424d..06d1313d37 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -894,14 +894,14 @@ simple manner." ["Sort by real name" gnus-group-sort-selected-groups-by-real-name (not (gnus-topic-mode-p))]) ("Mark" - ["Mark group" gnus-group-mark-group + ["Set/Toggle mark" gnus-group-mark-group (and (gnus-group-group-name) (not (memq (gnus-group-group-name) gnus-group-marked)))] - ["Unmark group" gnus-group-unmark-group + ["Remove mark" gnus-group-unmark-group (and (gnus-group-group-name) (memq (gnus-group-group-name) gnus-group-marked))] - ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] - ["Mark regexp..." gnus-group-mark-regexp t] + ["Remove all marks" gnus-group-unmark-all-groups gnus-group-marked] + ["Mark by regexp..." gnus-group-mark-regexp t] ["Mark region" gnus-group-mark-region :active mark-active] ["Mark buffer" gnus-group-mark-buffer t] ["Execute command" gnus-group-universal-argument @@ -1865,7 +1865,7 @@ If FIRST-TOO, the current line is also eligible as a target." (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (eq (char-after) gnus-process-mark))) -(defun gnus-group-mark-group (n &optional unmark no-advance) +(defun gnus-group-mark-group (n &optional unmark no-advance no-toggle) "Mark the current group." (interactive "p" gnus-group-mode) (let ((buffer-read-only nil) @@ -1877,23 +1877,33 @@ If FIRST-TOO, the current line is also eligible as a target." (beginning-of-line) (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (delete-char 1) - (if unmark - (progn - (setq gnus-group-marked (delete group gnus-group-marked)) - (insert-char ?\s 1 t)) - (setq gnus-group-marked - (cons group (delete group gnus-group-marked))) - (insert-char gnus-process-mark 1 t))) + (if (and gnus-process-mark-toggle (not no-toggle)) + (if (memq group gnus-group-marked) + (gnus-group-mark-update group t) + (gnus-group-mark-update group)) + (gnus-group-mark-update group unmark))) (unless no-advance (gnus-group-next-group 1)) (cl-decf n)) (gnus-group-position-point) n)) +(defun gnus-group-mark-update (n &optional unmark) + "Set the process mark on current group and update the group line." + (if unmark + (progn + (setq gnus-group-marked + (delete n gnus-group-marked)) + (insert-char ?\s 1 t)) + (progn + (setq gnus-group-marked + (cons n (delete n gnus-group-marked))) + (insert-char gnus-process-mark 1 t)))) + (defun gnus-group-unmark-group (n) "Remove the mark from the current group." (interactive "p" gnus-group-mode) - (gnus-group-mark-group n 'unmark) + (gnus-group-mark-group n 'unmark nil t) (gnus-group-position-point)) (defun gnus-group-unmark-all-groups () @@ -1910,7 +1920,7 @@ If UNMARK, remove the mark instead." (let ((num (count-lines beg end))) (save-excursion (goto-char beg) - (- num (gnus-group-mark-group num unmark))))) + (- num (gnus-group-mark-group num unmark nil t))))) (defun gnus-group-mark-buffer (&optional unmark) "Mark all groups in the buffer. @@ -1935,7 +1945,7 @@ If UNMARK, remove the mark instead." Return nil if the group isn't displayed." (if (gnus-group-goto-group group nil test-marked) (save-excursion - (gnus-group-mark-group 1 'unmark t) + (gnus-group-mark-group 1 'unmark t t) t) (setq gnus-group-marked (delete group gnus-group-marked)) @@ -1945,7 +1955,7 @@ Return nil if the group isn't displayed." "Set the process mark on GROUP." (if (gnus-group-goto-group group) (save-excursion - (gnus-group-mark-group 1 nil t)) + (gnus-group-mark-group 1 nil t t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) (defun gnus-group-universal-argument (arg &optional _groups func) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index aa4c753287..48794ceb3f 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -2774,7 +2774,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Hide marked" gnus-summary-limit-exclude-marks t] ["Show expunged" gnus-summary-limit-include-expunged t]) ("Process Mark" - ["Set mark" gnus-summary-mark-as-processable t] + ["Set/Toggle mark" gnus-summary-mark-as-processable t] ["Remove mark" gnus-summary-unmark-as-processable t] ["Remove all marks" gnus-summary-unmark-all-processable t] ["Invert marks" gnus-uu-invert-processable t] @@ -10951,10 +10951,14 @@ number of articles marked is returned." (n (abs n))) (while (and (> n 0) - (if unmark - (gnus-summary-remove-process-mark - (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) + (let ((article (gnus-summary-article-number))) + (if unmark + (gnus-summary-remove-process-mark article) + (if gnus-process-mark-toggle + (if (memq article gnus-newsgroup-processable) + (gnus-summary-remove-process-mark article) + (gnus-summary-set-process-mark article)) + (gnus-summary-set-process-mark article)))) (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) (setq n (1- n))) (when (/= 0 n) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index b3d17bc03f..c0484622f4 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -1112,7 +1112,7 @@ articles in the topic and its subtopics." ["Delete" gnus-topic-delete t] ["Rename..." gnus-topic-rename t] ["Create..." gnus-topic-create-topic t] - ["Mark" gnus-topic-mark-topic t] + ["Set/Toggle mark" gnus-topic-mark-topic t] ["Indent" gnus-topic-indent t] ["Sort" gnus-topic-sort-topics t] ["Previous topic" gnus-topic-goto-previous-topic t] @@ -1436,7 +1436,7 @@ If PERMANENT, make it stay shown in subsequent sessions as well." (setcar (cdr (cadr topic)) 'visible) (gnus-group-list-groups))))) -(defun gnus-topic-mark-topic (topic &optional unmark non-recursive) +(defun gnus-topic-mark-topic (topic &optional unmark non-recursive no-toggle) "Mark all groups in the TOPIC with the process mark. If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." (interactive @@ -1450,8 +1450,13 @@ If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil (not non-recursive)))) (while groups - (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) - (gnus-info-group (nth 1 (pop groups))))))))) + (let ((group (gnus-info-group (nth 1 (pop groups))))) + (if (and gnus-process-mark-toggle (not no-toggle)) + (if (memq group gnus-group-marked) + (gnus-group-remove-mark group ) + (gnus-group-set-mark group)) + (if unmark (gnus-group-remove-mark group) + (gnus-group-set-mark group))))))))) (defun gnus-topic-unmark-topic (topic &optional _dummy non-recursive) "Remove the process mark from all groups in the TOPIC. @@ -1462,7 +1467,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." gnus-topic-mode) (if (not topic) (call-interactively 'gnus-group-unmark-group) - (gnus-topic-mark-topic topic t non-recursive))) + (gnus-topic-mark-topic topic t non-recursive t))) (defun gnus-topic-get-new-news-this-topic (&optional n) "Check for new news in the current topic." diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 7de1cd1ddb..21b5f31c14 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1183,6 +1183,14 @@ newsgroups." :group 'gnus-summary-marks :type 'character) +(defcustom gnus-process-mark-toggle nil + "If non-nil the process mark command toggles the process mark." + :version "28.1" + :group 'gnus-summary + :group 'gnus-group-various + :group 'gnus-group-topic + :type 'boolean) + (defcustom gnus-large-newsgroup 200 "The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, commit 4784b6eb9a8d0d54b56db0805732ffc5e71332d3 Author: Basil L. Contovounesios Date: Tue Jun 1 17:59:46 2021 +0100 ; End recently added sentences with a period. diff --git a/etc/NEWS b/etc/NEWS index 914e689032..d0f903ffa6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -534,7 +534,7 @@ indentation is done using SMIE or with the old ad-hoc code. ** Icomplete +++ -*** New minor mode 'icomplete-vertical-mode', alias 'fido-vertical-mode' +*** New minor mode 'icomplete-vertical-mode', alias 'fido-vertical-mode'. This mode is intended to be used with Icomplete ('M-x icomplete-mode') or Fido ('M-x fido-mode'), to display the list of completions candidates vertically instead of horizontally. When used with diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 7c7961c4d5..c2b026dc82 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -484,7 +484,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." 'help-echo "mouse-2 or RET jumps to definition"))) (define-derived-mode elp-results-mode special-mode "ELP" - "Mode for ELP results" + "Mode for ELP results." :interactive nil) ;;;###autoload diff --git a/lisp/whitespace.el b/lisp/whitespace.el index b45d595cc2..aaa56835cd 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1040,7 +1040,7 @@ See also `whitespace-newline' and `whitespace-display-mappings'." ;; sync states (running a batch job) (setq global-whitespace-newline-mode global-whitespace-mode))) (make-obsolete 'global-whitespace-newline-mode - "Use `global-whitespace-mode' with `whitespace-style' set to `(newline-mark newline)' instead" + "use `global-whitespace-mode' with `whitespace-style' set to `(newline-mark newline)' instead." "28.1") commit 5e0cf09f1ebf32ab5b9325fda5c9264c60959ed0 Author: Basil L. Contovounesios Date: Tue Jun 1 18:04:48 2021 +0100 ; Bump isearch.el :version after recent change. diff --git a/lisp/isearch.el b/lisp/isearch.el index c47c66fc0f..c8bd62875f 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -412,7 +412,7 @@ A value of nil means highlight all matches in the buffer." :type '(choice (const :tag "All" nil) (integer :tag "Some")) :group 'lazy-highlight - :version "27.1") + :version "28.1") (defcustom lazy-highlight-buffer nil "Controls the lazy-highlighting of the full buffer. commit 246e107d73e633c06478eaf021776acedef9dafc Author: Alan Third Date: Fri May 21 13:33:56 2021 +0100 Improve performance of NS port's display on macOS * src/nsterm.h: Update EmacsSurface definition. * src/nsterm.m ([EmacsView focusOnDrawingBuffer]): Don't change the CGContext's settings directly. ([EmacsView unfocusDrawingBuffer]): Don't release the context here. (CACHE_MAX_SIZE): Add maximum cache size. ([EmacsView updateLayer]): Send a request for getContext, which will copy the buffer and create the context if it doesn't already exist, to the NS run loop. ([EmacsSurface initWithSize:ColorSpace:Scale:]): Add the scale factor and if there's already a CGContext available, reuse it. ([EmacsSurface dealloc]): No longer need to release lastSurface separately. ([EmacsSurface getContext]): Don't create more surfaces than we have spaces for in the cache. ([EmacsSurface releaseContext]): If there's no context don't try to release it and put currentSurface back on the cache instead of lastSurface. ([EmacsSurface copyContentsTo:]): Don't try to copy if the source and destination are actually the same surface. diff --git a/src/nsterm.h b/src/nsterm.h index 017c2394ef..0596f3f3c1 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -724,8 +724,9 @@ typedef id instancetype; IOSurfaceRef currentSurface; IOSurfaceRef lastSurface; CGContextRef context; + CGFloat scale; } -- (id) initWithSize: (NSSize)s ColorSpace: (CGColorSpaceRef)cs; +- (id) initWithSize: (NSSize)s ColorSpace: (CGColorSpaceRef)cs Scale: (CGFloat)scale; - (void) dealloc; - (NSSize) getSize; - (CGContextRef) getContext; diff --git a/src/nsterm.m b/src/nsterm.m index bb20886ab1..f6168243a4 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -8353,19 +8353,17 @@ - (void)focusOnDrawingBuffer surface = [[EmacsSurface alloc] initWithSize:s ColorSpace:[[[self window] colorSpace] - CGColorSpace]]; + CGColorSpace] + Scale:scale]; /* Since we're using NSViewLayerContentsRedrawOnSetNeedsDisplay the layer's scale factor is not set automatically, so do it now. */ - [[self layer] setContentsScale:[[self window] backingScaleFactor]]; + [[self layer] setContentsScale:scale]; } CGContextRef context = [surface getContext]; - CGContextTranslateCTM(context, 0, [surface getSize].height); - CGContextScaleCTM(context, scale, -scale); - [NSGraphicsContext setCurrentContext:[NSGraphicsContext graphicsContextWithCGContext:context @@ -8378,7 +8376,6 @@ - (void)unfocusDrawingBuffer NSTRACE ("[EmacsView unfocusDrawingBuffer]"); [NSGraphicsContext setCurrentContext:nil]; - [surface releaseContext]; [self setNeedsDisplay:YES]; } @@ -8516,7 +8513,11 @@ - (void)updateLayer There's a private method, -[CALayer setContentsChanged], that we could use to force it, but we shouldn't often get the same surface twice in a row. */ + [surface releaseContext]; [[self layer] setContents:(id)[surface getSurface]]; + [surface performSelectorOnMainThread:@selector (getContext) + withObject:nil + waitUntilDone:NO]; } #endif @@ -9717,17 +9718,20 @@ @implementation EmacsSurface probably be some sort of pruning job that removes excess surfaces. */ +#define CACHE_MAX_SIZE 2 - (id) initWithSize: (NSSize)s ColorSpace: (CGColorSpaceRef)cs + Scale: (CGFloat)scl { NSTRACE ("[EmacsSurface initWithSize:ColorSpace:]"); [super init]; - cache = [[NSMutableArray arrayWithCapacity:3] retain]; + cache = [[NSMutableArray arrayWithCapacity:CACHE_MAX_SIZE] retain]; size = s; colorSpace = cs; + scale = scl; return self; } @@ -9740,8 +9744,6 @@ - (void) dealloc if (currentSurface) CFRelease (currentSurface); - if (lastSurface) - CFRelease (lastSurface); for (id object in cache) CFRelease ((IOSurfaceRef)object); @@ -9764,50 +9766,66 @@ - (NSSize) getSize calls cannot be nested. */ - (CGContextRef) getContext { - IOSurfaceRef surface = NULL; - - NSTRACE ("[EmacsSurface getContextWithSize:]"); - NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (lastSurface ? 1 : 0)); + NSTRACE ("[EmacsSurface getContext]"); - for (id object in cache) + if (!context) { - if (!IOSurfaceIsInUse ((IOSurfaceRef)object)) - { - surface = (IOSurfaceRef)object; - [cache removeObject:object]; - break; - } - } + IOSurfaceRef surface = NULL; - if (!surface) - { - int bytesPerRow = IOSurfaceAlignProperty (kIOSurfaceBytesPerRow, - size.width * 4); + NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (lastSurface ? 1 : 0)); - surface = IOSurfaceCreate - ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber numberWithInt:size.width], - (id)kIOSurfaceHeight:[NSNumber numberWithInt:size.height], - (id)kIOSurfaceBytesPerRow:[NSNumber numberWithInt:bytesPerRow], - (id)kIOSurfaceBytesPerElement:[NSNumber numberWithInt:4], - (id)kIOSurfacePixelFormat:[NSNumber numberWithUnsignedInt:'BGRA']}); - } + for (id object in cache) + { + if (!IOSurfaceIsInUse ((IOSurfaceRef)object)) + { + surface = (IOSurfaceRef)object; + [cache removeObject:object]; + break; + } + } - IOReturn lockStatus = IOSurfaceLock (surface, 0, nil); - if (lockStatus != kIOReturnSuccess) - NSLog (@"Failed to lock surface: %x", lockStatus); + if (!surface && [cache count] >= CACHE_MAX_SIZE) + { + /* Just grab the first one off the cache. This may result + in tearing effects. The alternative is to wait for one + of the surfaces to become free. */ + surface = (IOSurfaceRef)[cache firstObject]; + [cache removeObject:(id)surface]; + } + else if (!surface) + { + int bytesPerRow = IOSurfaceAlignProperty (kIOSurfaceBytesPerRow, + size.width * 4); + + surface = IOSurfaceCreate + ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber numberWithInt:size.width], + (id)kIOSurfaceHeight:[NSNumber numberWithInt:size.height], + (id)kIOSurfaceBytesPerRow:[NSNumber numberWithInt:bytesPerRow], + (id)kIOSurfaceBytesPerElement:[NSNumber numberWithInt:4], + (id)kIOSurfacePixelFormat:[NSNumber numberWithUnsignedInt:'BGRA']}); + } + + IOReturn lockStatus = IOSurfaceLock (surface, 0, nil); + if (lockStatus != kIOReturnSuccess) + NSLog (@"Failed to lock surface: %x", lockStatus); - [self copyContentsTo:surface]; + [self copyContentsTo:surface]; - currentSurface = surface; + currentSurface = surface; + + context = CGBitmapContextCreate (IOSurfaceGetBaseAddress (currentSurface), + IOSurfaceGetWidth (currentSurface), + IOSurfaceGetHeight (currentSurface), + 8, + IOSurfaceGetBytesPerRow (currentSurface), + colorSpace, + (kCGImageAlphaPremultipliedFirst + | kCGBitmapByteOrder32Host)); + + CGContextTranslateCTM(context, 0, size.height); + CGContextScaleCTM(context, scale, -scale); + } - context = CGBitmapContextCreate (IOSurfaceGetBaseAddress (currentSurface), - IOSurfaceGetWidth (currentSurface), - IOSurfaceGetHeight (currentSurface), - 8, - IOSurfaceGetBytesPerRow (currentSurface), - colorSpace, - (kCGImageAlphaPremultipliedFirst - | kCGBitmapByteOrder32Host)); return context; } @@ -9818,6 +9836,9 @@ - (void) releaseContext { NSTRACE ("[EmacsSurface releaseContextAndGetSurface]"); + if (!context) + return; + CGContextRelease (context); context = NULL; @@ -9825,11 +9846,8 @@ - (void) releaseContext if (lockStatus != kIOReturnSuccess) NSLog (@"Failed to unlock surface: %x", lockStatus); - /* Put lastSurface back on the end of the cache. It may not have - been displayed on the screen yet, but we probably want the new - data and not some stale data anyway. */ - if (lastSurface) - [cache addObject:(id)lastSurface]; + /* Put currentSurface back on the end of the cache. */ + [cache addObject:(id)currentSurface]; lastSurface = currentSurface; currentSurface = NULL; } @@ -9854,7 +9872,7 @@ - (void) copyContentsTo: (IOSurfaceRef) destination NSTRACE ("[EmacsSurface copyContentsTo:]"); - if (! lastSurface) + if (!lastSurface || lastSurface == destination) return; lockStatus = IOSurfaceLock (lastSurface, kIOSurfaceLockReadOnly, nil); @@ -9874,6 +9892,7 @@ - (void) copyContentsTo: (IOSurfaceRef) destination NSLog (@"Failed to unlock source surface: %x", lockStatus); } +#undef CACHE_MAX_SIZE @end /* EmacsSurface */ commit a32e65b357ff634a976a24ee5d5c340addc025cd Author: Andrea Corallo Date: Tue Jun 1 17:17:42 2021 +0200 * Add `native-compile-target-directory' (bug#48743) * lisp/emacs-lisp/comp.el (native-compile-target-directory): New variable. (comp-spill-lap-function): Make use of. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index b9c80d1532..638d4b274c 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -200,6 +200,9 @@ Emacs Lisp file: \;; Local Variables:\n;; no-native-compile: t\n;; End:") ;;;###autoload(put 'no-native-compile 'safe-local-variable 'booleanp) +(defvar native-compile-target-directory nil + "When non-nil force the target directory for the eln files being compiled.") + (defvar comp-log-time-report nil "If non-nil, log a time report for each pass.") @@ -1337,8 +1340,9 @@ clashes." (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) (comp-el-to-eln-filename filename - (when byte+native-compile - (car (last native-comp-eln-load-path)))))) + (or native-compile-target-directory + (when byte+native-compile + (car (last native-comp-eln-load-path))))))) (setf (comp-ctxt-speed comp-ctxt) (alist-get 'native-comp-speed byte-native-qualities) (comp-ctxt-debug comp-ctxt) (alist-get 'native-comp-debug @@ -4183,9 +4187,9 @@ Native compilation equivalent to `batch-byte-compile'." "Like `batch-native-compile', but used for bootstrap. Generate .elc files in addition to the .eln files. Force the produced .eln to be outputted in the eln system -directory (the last entry in `native-comp-eln-load-path'). -If the environment variable 'NATIVE_DISABLED' is set, only byte -compile." +directory (the last entry in `native-comp-eln-load-path') unless +`native-compile-target-directory' is non-nil. If the environment +variable 'NATIVE_DISABLED' is set, only byte compile." (comp-ensure-native-compiler) (if (equal (getenv "NATIVE_DISABLED") "1") (batch-byte-compile) commit c4b02dad9bdf233888164067d5942c0d7642cae2 Author: Andrea Corallo Date: Tue Jun 1 17:10:10 2021 +0200 Rename batch-byte-native-compile-for-bootstrap (bug#48743) * lisp/Makefile.in : Rename `batch-byte-native-compile-for-bootstrap' -> `batch-byte+native-compile. * lisp/emacs-lisp/bytecomp.el (byte+native-compile) (byte-compile-file): Rename `batch-byte-native-compile-for-bootstrap' -> `batch-byte+native-compile + `byte-native-for-bootstrap' -> `byte+native-compile'. * lisp/emacs-lisp/comp.el (comp-spill-lap-function, comp-final) (batch-native-compile, batch-byte+native-compile): Likewise. * lisp/emacs-lisp/bytecomp.el (byte+native-compile) (byte-compile-file): Likewise. * test/src/comp-tests.el (comp-tests-bootstrap): Rename `byte-native-for-bootstrap' -> `byte+native-compile'. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 8e0d9c4e5b..431217a9da 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -274,7 +274,7 @@ $(THEFILE)c: ifeq ($(HAVE_NATIVE_COMP),yes) $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ -l comp -f byte-compile-refresh-preloaded \ - -f batch-byte-native-compile-for-bootstrap $(THEFILE) + -f batch-byte+native-compile $(THEFILE) else $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ -l bytecomp -f byte-compile-refresh-preloaded \ @@ -295,7 +295,7 @@ endif ifeq ($(HAVE_NATIVE_COMP),yes) .el.elc: $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ - -l comp -f batch-byte-native-compile-for-bootstrap $< + -l comp -f batch-byte+native-compile $< else .el.elc: $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $< diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 86c5d32c72..96a0da924f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -606,7 +606,7 @@ Each element is (INDEX . VALUE)") "Non nil while native compiling.") (defvar byte-native-qualities nil "To spill default qualities from the compiled file.") -(defvar byte-native-for-bootstrap nil +(defvar byte+native-compile nil "Non nil while compiling for bootstrap." ;; During bootstrap we produce both the .eln and the .elc together. ;; Because the make target is the later this has to be produced as @@ -2109,7 +2109,7 @@ See also `emacs-lisp-byte-compile-and-load'." ;; recompiled). Previously this was accomplished by ;; deleting target-file before writing it. (if byte-native-compiling - (if byte-native-for-bootstrap + (if byte+native-compile ;; Defer elc final renaming. (setf byte-to-native-output-file (cons tempfile target-file)) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index fa5a4522c3..b9c80d1532 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1337,7 +1337,7 @@ clashes." (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) (comp-el-to-eln-filename filename - (when byte-native-for-bootstrap + (when byte+native-compile (car (last native-comp-eln-load-path)))))) (setf (comp-ctxt-speed comp-ctxt) (alist-get 'native-comp-speed byte-native-qualities) @@ -3643,7 +3643,7 @@ Prepare every function for final compilation and drive the C back-end." ;; unless during bootstrap or async compilation (bug#45056). GCC ;; leaks memory but also interfere with the ability of Emacs to ;; detect when a sub-process completes (TODO understand why). - (if (or byte-native-for-bootstrap comp-async-compilation) + (if (or byte+native-compile comp-async-compilation) (comp-final1) ;; Call comp-final1 in a child process. (let* ((output (comp-ctxt-output comp-ctxt)) @@ -4171,7 +4171,7 @@ it won’t work in an interactive Emacs. Native compilation equivalent to `batch-byte-compile'." (comp-ensure-native-compiler) (cl-loop for file in command-line-args-left - if (or (null byte-native-for-bootstrap) + if (or (null byte+native-compile) (cl-notany (lambda (re) (string-match re file)) native-comp-bootstrap-deny-list)) do (comp--native-compile file) @@ -4179,7 +4179,7 @@ Native compilation equivalent to `batch-byte-compile'." do (byte-compile-file file))) ;;;###autoload -(defun batch-byte-native-compile-for-bootstrap () +(defun batch-byte+native-compile () "Like `batch-native-compile', but used for bootstrap. Generate .elc files in addition to the .eln files. Force the produced .eln to be outputted in the eln system @@ -4190,7 +4190,7 @@ compile." (if (equal (getenv "NATIVE_DISABLED") "1") (batch-byte-compile) (cl-assert (length= command-line-args-left 1)) - (let ((byte-native-for-bootstrap t) + (let ((byte+native-compile t) (byte-to-native-output-file nil)) (batch-native-compile) (pcase byte-to-native-output-file diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index be02c30a75..fb9441eb66 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -53,7 +53,7 @@ "Compile the compiler and load it to compile it-self. Check that the resulting binaries do not differ." :tags '(:expensive-test :nativecomp) - (let* ((byte-native-for-bootstrap t) ; FIXME HACK + (let* ((byte+native-compile t) ; FIXME HACK (comp-src (expand-file-name "../../../lisp/emacs-lisp/comp.el" (ert-resource-directory))) (comp1-src (make-temp-file "stage1-" nil ".el")) commit 3dff85419902e52239ea971f8cbde523cc785e5d Author: Glenn Morris Date: Tue Jun 1 08:52:47 2021 -0700 Remove unnecessary function declaration in isearch * lisp/isearch.el (multi-isearch-switch-buffer): Remove unnecessary declaration (after ldefs-boot update). diff --git a/lisp/isearch.el b/lisp/isearch.el index 33776d8069..c47c66fc0f 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -3462,10 +3462,6 @@ Can be changed via `isearch-search-fun-function' for special needs." (if isearch-forward #'re-search-forward #'re-search-backward) regexp bound noerror count)))) -;; This is for when we compile this file during bootstrap, with -;; loaddefs.el still not loaded. -(declare-function multi-isearch-switch-buffer "misearch" ()) - (defun isearch-search-string (string bound noerror) "Search for the first occurrence of STRING or its translation. STRING's characters are translated using `translation-table-for-input' commit 8b3291d13442e88bf379d3cad1fcc5094265ded3 Author: Andreas Schwab Date: Tue Jun 1 15:46:34 2021 +0200 Avoid hang in nnimap-keepalive * lisp/gnus/nnimap.el (nnimap-keepalive): Make interruptable. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index f869f586d9..3e2a202a6c 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -428,8 +428,9 @@ during splitting, which may be slow." (time-subtract now (nnimap-last-command-time nnimap-object)))) - (ignore-errors ;E.g. "buffer foo has no process". - (nnimap-send-command "NOOP")))))))) + (with-local-quit + (ignore-errors ;E.g. "buffer foo has no process". + (nnimap-send-command "NOOP"))))))))) (defun nnimap-open-connection (buffer) ;; Be backwards-compatible -- the earlier value of nnimap-stream was commit afe7d9bd59258754ddbac1fb2e4b51cc4d8669b4 Author: Glenn Morris Date: Tue Jun 1 06:29:13 2021 -0700 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 613223b3c5..f490bfbb35 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -1063,7 +1063,7 @@ or a non-nil `apropos-do-all' argument. \(fn PATTERN)" t nil) -(defalias 'command-apropos 'apropos-command) +(defalias 'command-apropos #'apropos-command) (autoload 'apropos-command "apropos" "\ Show commands (interactively callable functions) that match PATTERN. @@ -5339,14 +5339,14 @@ clashes. \(fn NAME PREFIX &optional FIRST)" nil nil) (autoload 'comp-clean-up-stale-eln "comp" "\ -Given FILE remove all its *.eln files in `comp-eln-load-path' +Given FILE remove all its *.eln files in `native-comp-eln-load-path' sharing the original source filename (including FILE). \(fn FILE)" nil nil) (autoload 'comp-lookup-eln "comp" "\ Given a Lisp source FILENAME return the corresponding .eln file if found. -Search happens in `comp-eln-load-path'. +Search happens in `native-comp-eln-load-path'. \(fn FILENAME)" nil nil) @@ -5374,7 +5374,7 @@ Native compilation equivalent to `batch-byte-compile'." nil nil) Like `batch-native-compile', but used for bootstrap. Generate .elc files in addition to the .eln files. Force the produced .eln to be outputted in the eln system -directory (the last entry in `comp-eln-load-path'). +directory (the last entry in `native-comp-eln-load-path'). If the environment variable 'NATIVE_DISABLED' is set, only byte compile." nil nil) @@ -5394,7 +5394,7 @@ nil -- Select all files. a string -- A regular expression selecting files with matching names. a function -- A function selecting files with matching names. -The variable `comp-async-jobs-number' specifies the number +The variable `native-comp-async-jobs-number' specifies the number of (commands) to run simultaneously. \(fn FILES &optional RECURSIVELY LOAD SELECTOR)" nil nil) @@ -7209,6 +7209,12 @@ information on adapting behavior of commands in Delete Selection mode. \(fn &optional ARG)" t nil) +(autoload 'delete-active-region "delsel" "\ +Delete the active region. +If KILLP in not-nil, the active region is killed instead of deleted. + +\(fn &optional KILLP)" t nil) + (register-definition-prefixes "delsel" '("del" "minibuffer-keyboard-quit")) ;;;*** @@ -9389,6 +9395,26 @@ an EDE controlled project. ;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/edebug.el +(defvar edebug-all-defs nil "\ +If non-nil, evaluating defining forms instruments for Edebug. +This applies to `eval-defun', `eval-region', `eval-buffer', and +`eval-current-buffer'. `eval-region' is also called by +`eval-last-sexp', and `eval-print-last-sexp'. + +You can use the command `edebug-all-defs' to toggle the value of this +variable. You may wish to make it local to each buffer with +\(make-local-variable \\='edebug-all-defs) in your +`emacs-lisp-mode-hook'.") + +(custom-autoload 'edebug-all-defs "edebug" t) + +(defvar edebug-all-forms nil "\ +Non-nil means evaluation of all forms will instrument for Edebug. +This doesn't apply to loading or evaluations in the minibuffer. +Use the command `edebug-all-forms' to toggle the value of this option.") + +(custom-autoload 'edebug-all-forms "edebug" t) + (autoload 'edebug-basic-spec "edebug" "\ Return t if SPEC uses only extant spec symbols. An extant spec symbol is a symbol that is not a function and has a @@ -10543,6 +10569,26 @@ Encrypt marked files." t nil) (register-definition-prefixes "epa-file" '("epa-")) +;;;*** + +;;;### (autoloads nil "epa-ks" "epa-ks.el" (0 0 0 0)) +;;; Generated autoloads from epa-ks.el + +(autoload 'epa-search-keys "epa-ks" "\ +Ask a keyserver for all keys matching QUERY. + +The keyserver to be used is specified by `epa-keyserver'. + +If EXACT is non-nil (interactively, prefix argument), require +exact matches. + +Note that the request may fail if the query is not specific +enough, since keyservers have strict timeout settings. + +\(fn QUERY EXACT)" t nil) + +(register-definition-prefixes "epa-ks" '("epa-k")) + ;;;*** ;;;### (autoloads nil "epa-mail" "epa-mail.el" (0 0 0 0)) @@ -10758,8 +10804,8 @@ Example usage: (erc-tls :server \"chat.freenode.net\" :port 6697 :client-certificate - '(\"/data/bandali/my-cert.key\" - \"/data/bandali/my-cert.crt\")) + '(\"/home/bandali/my-cert.key\" + \"/home/bandali/my-cert.crt\")) \(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)) CLIENT-CERTIFICATE)" t nil) @@ -12603,6 +12649,10 @@ Being on a `#include' line pulls in that file. If optional IN-OTHER-WINDOW is non-nil, find the file in the other window. If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines. +If optional EVENT is non-nil (default `last-nonmenu-event', move +point to the end position of that event before calling the +various ff-* hooks. + Variables of interest include: - `ff-case-fold-search' @@ -15762,6 +15812,12 @@ When called from lisp, FUNCTION may also be a function object. \(fn FUNCTION)" t nil) +(autoload 'describe-command "help-fns" "\ +Display the full documentation of COMMAND (a symbol). +When called from lisp, COMMAND may also be a function object. + +\(fn COMMAND)" t nil) + (autoload 'help-C-file-name "help-fns" "\ Return the name of the C file where SUBR-OR-VAR is defined. KIND should be `var' for a variable or `subr' for a subroutine. @@ -16076,22 +16132,30 @@ also supported. There are several ways to change text in hexl mode: -ASCII characters (character between space (0x20) and tilde (0x7E)) are -bound to self-insert so you can simply type the character and it will -insert itself (actually overstrike) into the buffer. +Self-inserting characters are bound to `hexl-self-insert' so you +can simply type the character and it will insert itself (actually +overstrike) into the buffer. However, inserting non-ASCII characters +requires caution: the buffer's coding-system should correspond to +the encoding on disk, and multibyte characters should be inserted +with cursor on the first byte of a multibyte sequence whose length +is identical to the length of the multibyte sequence to be inserted, +otherwise this could produce invalid multibyte sequences. Non-ASCII +characters in ISO-2022 encodings should preferably inserted byte by +byte, to avoid problems caused by the designation sequences before +the actual characters. \\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if it isn't bound to self-insert. An octal number can be supplied in place of another key to insert the octal number's ASCII representation. -\\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF) -into the buffer at the current point. +\\[hexl-insert-hex-char] will insert a given hexadecimal value +into the buffer at the current address. -\\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377) -into the buffer at the current point. +\\[hexl-insert-octal-char] will insert a given octal value +into the buffer at the current address. -\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255) -into the buffer at the current point. +\\[hexl-insert-decimal-char] will insert a given decimal value +into the buffer at the current address.. \\[hexl-mode-exit] will exit `hexl-mode'. @@ -16107,7 +16171,8 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. (autoload 'hexl-find-file "hexl" "\ Edit file FILENAME as a binary file in hex dump format. Switch to a buffer visiting file FILENAME, creating one if none exists, -and edit the file in `hexl-mode'. +and edit the file in `hexl-mode'. The buffer's coding-system will be +no-conversion, unlike if you visit it normally and then invoke `hexl-mode'. \(fn FILENAME)" t nil) @@ -17195,7 +17260,7 @@ resized depends on `resize-mini-windows'. (make-obsolete 'iswitchb-mode "use `icomplete-mode' or `ido-mode' instead." "24.4")) -(register-definition-prefixes "icomplete" '("icomplete-")) +(register-definition-prefixes "icomplete" '("fido-vertical-mode" "icomplete-")) ;;;*** @@ -19272,7 +19337,7 @@ It is not recommended to set this variable permanently to anything but nil.") Uninstall jka-compr. This removes the entries in `file-name-handler-alist' and `auto-mode-alist' and `inhibit-local-variables-suffixes' that were added -by `jka-compr-installed'." nil nil) +by `jka-compr-install'." nil nil) (register-definition-prefixes "jka-compr" '("compression-error" "jka-compr-")) @@ -19437,12 +19502,12 @@ and the return value is the length of the conversion. ;;;### (autoloads nil "kmacro" "kmacro.el" (0 0 0 0)) ;;; Generated autoloads from kmacro.el - (global-set-key "\C-x(" 'kmacro-start-macro) - (global-set-key "\C-x)" 'kmacro-end-macro) - (global-set-key "\C-xe" 'kmacro-end-and-call-macro) - (global-set-key [f3] 'kmacro-start-macro-or-insert-counter) - (global-set-key [f4] 'kmacro-end-or-call-macro) - (global-set-key "\C-x\C-k" 'kmacro-keymap) + (global-set-key "\C-x(" #'kmacro-start-macro) + (global-set-key "\C-x)" #'kmacro-end-macro) + (global-set-key "\C-xe" #'kmacro-end-and-call-macro) + (global-set-key [f3] #'kmacro-start-macro-or-insert-counter) + (global-set-key [f4] #'kmacro-end-or-call-macro) + (global-set-key "\C-x\C-k" #'kmacro-keymap) (autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap) (autoload 'kmacro-exec-ring-item "kmacro" "\ @@ -19950,28 +20015,28 @@ except that FILTER is not optional. ;;; Generated autoloads from vc/log-edit.el (autoload 'log-edit "log-edit" "\ -Setup a buffer to enter a log message. -The buffer is put in mode MODE or `log-edit-mode' if MODE is nil. +Setup a buffer to enter a VC commit log message. +The buffer is put in mode MODE, or `log-edit-mode' if MODE is nil. \\ If SETUP is non-nil, erase the buffer and run `log-edit-hook'. Set mark and point around the entire contents of the buffer, so that it is easy to kill the contents of the buffer with -\\[kill-region]. Once the user is done editing the message, -invoking the command \\[log-edit-done] (`log-edit-done') will -call CALLBACK to do the actual commit. +\\[kill-region]. Once the user is done editing the message, he +or she is expected to invoke the command \\[log-edit-done] (`log-edit-done'), +which will call CALLBACK, a function to do the actual commit. -PARAMS if non-nil is an alist of variables and buffer-local -values to give them in the Log Edit buffer. Possible keys and -associated values: +PARAMS, if non-nil, is an alist of variables and buffer-local +values to give to those variables in the Log Edit buffer. Possible +keys and associated values are: `log-edit-listfun' -- function taking no arguments that returns the list of - files that are concerned by the current operation (using relative names); + files that are concerned by the current operation (using relative names); `log-edit-diff-function' -- function taking no arguments that - displays a diff of the files concerned by the current operation. + displays a diff of the files concerned by the current operation. `vc-log-fileset' -- the VC fileset to be committed (if any). -If BUFFER is non-nil `log-edit' will jump to that buffer, use it +If BUFFER is non-nil, `log-edit' will switch to that buffer, use it to edit the log message and go back to the current buffer when -done. Otherwise, it uses the current buffer. +done. Otherwise, this function will use the current buffer. \(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil) @@ -20511,6 +20576,50 @@ The mail client is taken to be the handler of mailto URLs." nil nil) ;;;### (autoloads nil "mairix" "net/mairix.el" (0 0 0 0)) ;;; Generated autoloads from net/mairix.el +(autoload 'mairix-search "mairix" "\ +Call Mairix with SEARCH. +If THREADS is non-nil, also display whole threads of found +messages. Results will be put into the default search file. + +\(fn SEARCH THREADS)" t nil) + +(autoload 'mairix-use-saved-search "mairix" "\ +Use a saved search for querying Mairix." t nil) + +(autoload 'mairix-edit-saved-searches-customize "mairix" "\ +Edit the list of saved searches in a customization buffer." t nil) + +(autoload 'mairix-search-from-this-article "mairix" "\ +Search messages from sender of the current article. +This is effectively a shortcut for calling `mairix-search' with +f:current_from. If prefix THREADS is non-nil, include whole +threads. + +\(fn THREADS)" t nil) + +(autoload 'mairix-search-thread-this-article "mairix" "\ +Search thread for the current article. +This is effectively a shortcut for calling `mairix-search' +with m:msgid of the current article and enabled threads." t nil) + +(autoload 'mairix-widget-search-based-on-article "mairix" "\ +Create mairix query based on current article using widgets." t nil) + +(autoload 'mairix-edit-saved-searches "mairix" "\ +Edit current mairix searches." t nil) + +(autoload 'mairix-widget-search "mairix" "\ +Create mairix query interactively using graphical widgets. +MVALUES may contain values from current article. + +\(fn &optional MVALUES)" t nil) + +(autoload 'mairix-update-database "mairix" "\ +Call mairix for updating the database for SERVERS. +Mairix will be called asynchronously unless +`mairix-synchronous-update' is t. Mairix will be called with +`mairix-update-options'." t nil) + (register-definition-prefixes "mairix" '("mairix-")) ;;;*** @@ -21518,6 +21627,9 @@ Sequence of files visited by multiple file buffers Isearch.") Set up isearch to search multiple buffers. Intended to be added to `isearch-mode-hook'." nil nil) +(autoload 'multi-isearch-switch-buffer "misearch" "\ +Switch to the next buffer in multi-buffer search." nil nil) + (autoload 'multi-isearch-buffers "misearch" "\ Start multi-buffer Isearch on a list of BUFFERS. This list can contain live buffers or their names. @@ -24243,7 +24355,7 @@ Turning on outline mode calls the value of `text-mode-hook' and then of \(fn)" t nil) (put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp) -(put 'outline-minor-mode-highlight 'safe-local-variable 'booleanp) +(put 'outline-minor-mode-highlight 'safe-local-variable 'symbolp) (autoload 'outline-minor-mode "outline" "\ Toggle Outline minor mode. @@ -25312,14 +25424,14 @@ Macroexpand EXPRESSION and pretty-print its value. (autoload 'pp-eval-last-sexp "pp" "\ Run `pp-eval-expression' on sexp before point. -With argument, pretty-print output into current buffer. +With ARG, pretty-print output into current buffer. Ignores leading comment characters. \(fn ARG)" t nil) (autoload 'pp-macroexpand-last-sexp "pp" "\ Run `pp-macroexpand-expression' on sexp before point. -With argument, pretty-print output into current buffer. +With ARG, pretty-print output into current buffer. Ignores leading comment characters. \(fn ARG)" t nil) @@ -26996,7 +27108,12 @@ the regexp builder. It displays a buffer named \"*RE-Builder*\" in another window, initially containing an empty regexp. As you edit the regexp in the \"*RE-Builder*\" buffer, the -matching parts of the target buffer will be highlighted." t nil) +matching parts of the target buffer will be highlighted. + +Case-sensitivity can be toggled with \\[reb-toggle-case]. The +regexp builder supports three different forms of input which can +be set with \\[reb-change-syntax]. More options and details are +provided in the Commentary section of this library." t nil) (register-definition-prefixes "re-builder" '("re-builder-unload-function" "reb-")) @@ -28016,28 +28133,37 @@ than appending to it. Deletes the message after writing if ;;; Generated autoloads from emacs-lisp/rmc.el (autoload 'read-multiple-choice "rmc" "\ -Ask user a multiple choice question. -PROMPT should be a string that will be displayed as the prompt. - -CHOICES is a list of (KEY NAME [DESCRIPTION]). KEY is a -character to be entered. NAME is a short name for the entry to -be displayed while prompting (if there's room, it might be -shortened). DESCRIPTION is an optional longer explanation that -will be displayed in a help buffer if the user requests more -help. +Ask user to select an entry from CHOICES, promting with PROMPT. +This function allows to ask the user a multiple-choice question. + +CHOICES should be a list of the form (KEY NAME [DESCRIPTION]). +KEY is a character the user should type to select the entry. +NAME is a short name for the entry to be displayed while prompting +\(if there's no room, it might be shortened). +DESCRIPTION is an optional longer description of the entry; it will +be displayed in a help buffer if the user requests more help. This +help description has a fixed format in columns. For greater +flexibility, instead of passing a DESCRIPTION, the caller can pass +the optional argument HELP-STRING. This argument is a string that +should contain a more detailed description of all of the possible +choices. `read-multiple-choice' will display that description in a +help buffer if the user requests that. This function translates user input into responses by consulting the bindings in `query-replace-map'; see the documentation of -that variable for more information. In this case, the useful -bindings are `recenter', `scroll-up', and `scroll-down'. If the -user enters `recenter', `scroll-up', or `scroll-down' responses, -perform the requested window recentering or scrolling and ask -again. - -When `use-dialog-box' is t (the default), this function can pop -up a dialog window to collect the user input. That functionality -requires `display-popup-menus-p' to return t. Otherwise, a -text dialog will be used. +that variable for more information. The relevant bindings for the +purposes of this function are `recenter', `scroll-up', `scroll-down', +and `edit'. +If the user types the `recenter', `scroll-up', or `scroll-down' +responses, the function performs the requested window recentering or +scrolling, and then asks the question again. If the user enters `edit', +the function starts a recursive edit. When the user exit the recursive +edit, the multiple-choice prompt gains focus again. + +When `use-dialog-box' is t (the default), and the command using this +function was invoked via the mouse, this function pops up a GUI dialog +to collect the user input, but only if Emacs is capable of using GUI +dialogs. Otherwise, the function will always use text-mode dialogs. The return value is the matching entry from the CHOICES list. @@ -28048,7 +28174,7 @@ Usage example: (?s \"session only\") (?n \"no\"))) -\(fn PROMPT CHOICES)" nil nil) +\(fn PROMPT CHOICES &optional HELP-STRING)" nil nil) ;;;*** @@ -28559,7 +28685,7 @@ For more details, see Info node `(elisp) Extending Rx'. (function-put 'rx-define 'lisp-indent-function 'defun) -(eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form.\nREGEXPS are interpreted as in `rx'. The pattern matches any\nstring that is a match for REGEXPS, as if by `string-match'.\n\nIn addition to the usual `rx' syntax, REGEXPS can contain the\nfollowing constructs:\n\n (let REF RX...) binds the symbol REF to a submatch that matches\n the regular expressions RX. REF is bound in\n CODE to the string of the submatch or nil, but\n can also be used in `backref'.\n (backref REF) matches whatever the submatch REF matched.\n REF can be a number, as usual, or a name\n introduced by a previous (let REF ...)\n construct." (let* ((rx--pcase-vars nil) (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps)))) (nvars (length rx--pcase-vars))) `(and (pred stringp) ,(if (zerop nvars) `(pred (string-match ,regexp)) `(app (lambda (s) (and (string-match ,regexp s) ,(rx--reduce-right (lambda (a b) `(cons ,a ,b)) (mapcar (lambda (i) `(match-string ,i s)) (number-sequence 1 nvars))))) ,(list '\` (rx--reduce-right #'cons (mapcar (lambda (name) (list '\, name)) (reverse rx--pcase-vars)))))))))) +(eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form.\nREGEXPS are interpreted as in `rx'. The pattern matches any\nstring that is a match for REGEXPS, as if by `string-match'.\n\nIn addition to the usual `rx' syntax, REGEXPS can contain the\nfollowing constructs:\n\n (let REF RX...) binds the symbol REF to a submatch that matches\n the regular expressions RX. REF is bound in\n CODE to the string of the submatch or nil, but\n can also be used in `backref'.\n (backref REF) matches whatever the submatch REF matched.\n REF can be a number, as usual, or a name\n introduced by a previous (let REF ...)\n construct." (let* ((rx--pcase-vars nil) (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps))))) `(and (pred stringp) ,(pcase (length rx--pcase-vars) (0 `(pred (string-match ,regexp))) (1 `(app (lambda (s) (if (string-match ,regexp s) (match-string 1 s) 0)) (and ,(car rx--pcase-vars) (pred (not numberp))))) (nvars `(app (lambda (s) (and (string-match ,regexp s) ,(rx--reduce-right (lambda (a b) `(cons ,a ,b)) (mapcar (lambda (i) `(match-string ,i s)) (number-sequence 1 nvars))))) ,(list '\` (rx--reduce-right #'cons (mapcar (lambda (name) (list '\, name)) (reverse rx--pcase-vars))))))))))) (define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil) @@ -29934,7 +30060,7 @@ Pop to a buffer with short documentation summary for functions in GROUP. \(fn GROUP)" t nil) -(register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "list" "number" "process" "regexp" "sequence" "shortdoc-" "string" "vector")) +(register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "list" "number" "overlay" "process" "regexp" "sequence" "shortdoc-" "string" "vector")) ;;;*** @@ -34136,10 +34262,10 @@ match file names at root of the underlying local file system, like \"/sys\" or \"/C:\".") (defun tramp-autoload-file-name-handler (operation &rest args) "\ -Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory temporary-file-directory)) (load "tramp" 'noerror 'nomessage))) (apply operation args)) +Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory temporary-file-directory)) (when (bound-and-true-p tramp-archive-autoload) (load "tramp-archive" 'noerror 'nomessage)) (load "tramp" 'noerror 'nomessage))) (apply operation args)) (defun tramp-register-autoload-file-name-handlers nil "\ -Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp 'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t)) +Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp #'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t)) (tramp-register-autoload-file-name-handlers) (defun tramp-unload-file-name-handlers nil "\ @@ -34177,7 +34303,8 @@ It must be supported by libarchive(3).") (defmacro tramp-archive-autoload-file-name-regexp nil "\ Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'")) -(defalias 'tramp-archive-autoload-file-name-handler #'tramp-autoload-file-name-handler) +(defun tramp-archive-autoload-file-name-handler (operation &rest args) "\ +Load Tramp archive file name handler, and perform OPERATION." (when tramp-archive-enabled (let ((default-directory temporary-file-directory) (tramp-archive-autoload t)) tramp-archive-autoload (apply #'tramp-autoload-file-name-handler operation args)))) (defun tramp-register-archive-file-name-handler nil "\ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t))) commit 3d954dee9cb030384c54a5d3b87d45573cfa8f70 Author: Stefan Monnier Date: Tue Jun 1 09:14:53 2021 -0400 * lisp/gnus/gnus-art.el: Don't sneak dynbound code via quoting Make sure we don't accidentally quote lambdas by embedding them within quoted data. (gnus-visible-headers, gnus-emphasis-alist) (gnus-mime-display-alternative, gnus-article-describe-bindings): Unquote lambdas. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 5ce03db1b9..f2ec9462c5 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -170,12 +170,17 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored." "All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored." - :type '(choice - (repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) + :type `(choice + (repeat :value-to-internal + ,(lambda (_widget value) + ;; FIXME: Are we sure this can't be used without + ;; loading cus-edit? + (declare-function custom-split-regexp-maybe + "cus-edit" (regexp)) + (custom-split-regexp-maybe value)) + :match ,(lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) regexp) (const :tag "Use gnus-ignored-headers" nil) regexp) @@ -402,14 +407,14 @@ the entire emphasized word. The third is a number that says what regexp grouping should be displayed and highlighted. The fourth is the face used for highlighting." :type - '(repeat + `(repeat (menu-choice :format "%[Customizing Style%]\n%v" :indent 2 (group :tag "Default" :value ("" 0 0 default) :value-create - (lambda (widget) + ,(lambda (widget) (let ((value (widget-get (cadr (widget-get (widget-get widget :parent) :args)) @@ -3738,7 +3743,7 @@ is to run." (setq n 1)) (gnus-stop-date-timer) (setq article-lapsed-timer - (run-at-time 1 n 'article-update-date-lapsed))) + (run-at-time 1 n #'article-update-date-lapsed))) (defun gnus-stop-date-timer () "Stop the Date timer." @@ -4405,7 +4410,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is "\M-g" gnus-article-read-summary-keys) (substitute-key-definition - 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) + #'undefined #'gnus-article-read-summary-keys gnus-article-mode-map) (defvar gnus-article-send-map) (gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) @@ -4483,12 +4488,12 @@ commands: (make-local-variable 'gnus-article-image-alist) (make-local-variable 'gnus-article-charset) (make-local-variable 'gnus-article-ignored-charsets) - (setq-local bookmark-make-record-function 'gnus-summary-bookmark-make-record) + (setq-local bookmark-make-record-function #'gnus-summary-bookmark-make-record) ;; Prevent Emacs from displaying non-break space with ;; `nobreak-space' face. (setq-local nobreak-char-display nil) ;; Enable `gnus-article-remove-images' to delete images shr.el renders. - (setq-local shr-put-image-function 'gnus-shr-put-image) + (setq-local shr-put-image-function #'gnus-shr-put-image) (unless gnus-article-show-cursor (setq cursor-in-non-selected-windows nil)) (gnus-set-default-directory) @@ -4723,16 +4728,17 @@ If ALL-HEADERS is non-nil, no headers are hidden." (define-derived-mode gnus-sticky-article-mode gnus-article-mode "StickyArticle" "Mode for sticky articles." ;; Release bindings that won't work. - (substitute-key-definition 'gnus-article-read-summary-keys 'undefined + (substitute-key-definition #'gnus-article-read-summary-keys #'undefined gnus-sticky-article-mode-map) - (substitute-key-definition 'gnus-article-refer-article 'undefined + (substitute-key-definition #'gnus-article-refer-article #'undefined gnus-sticky-article-mode-map) (dolist (k '("e" "h" "s" "F" "R")) (define-key gnus-sticky-article-mode-map k nil)) - (define-key gnus-sticky-article-mode-map "k" 'gnus-kill-sticky-article-buffer) - (define-key gnus-sticky-article-mode-map "q" 'bury-buffer) - (define-key gnus-sticky-article-mode-map "\C-hc" 'describe-key-briefly) - (define-key gnus-sticky-article-mode-map "\C-hk" 'describe-key)) + (define-key gnus-sticky-article-mode-map "k" + #'gnus-kill-sticky-article-buffer) + (define-key gnus-sticky-article-mode-map "q" #'bury-buffer) + (define-key gnus-sticky-article-mode-map "\C-hc" #'describe-key-briefly) + (define-key gnus-sticky-article-mode-map "\C-hk" #'describe-key)) (defun gnus-sticky-article (arg) "Make the current article sticky. @@ -4863,9 +4869,9 @@ General format specifiers can also be used. See Info node (defvar gnus-mime-button-map (let ((map (make-sparse-keymap))) - (define-key map "\r" 'gnus-article-push-button) - (define-key map [mouse-2] 'gnus-article-push-button) - (define-key map [down-mouse-3] 'gnus-mime-button-menu) + (define-key map "\r" #'gnus-article-push-button) + (define-key map [mouse-2] #'gnus-article-push-button) + (define-key map [down-mouse-3] #'gnus-mime-button-menu) (dolist (c gnus-mime-button-commands) (define-key map (cadr c) (car c))) map)) @@ -6138,7 +6144,7 @@ If nil, don't show those extra buttons." (let* ((preferred (or preferred (mm-preferred-alternative handles))) (ihandles handles) (point (point)) - handle (inhibit-read-only t) begend not-pref) ;; from + (inhibit-read-only t) begend not-pref) ;; from (save-window-excursion (save-restriction (when ibegend @@ -6152,8 +6158,8 @@ If nil, don't show those extra buttons." (mm-remove-parts handles)) (setq begend (list (point-marker))) ;; Do the toggle. - (unless (setq not-pref (cadr (member preferred ihandles))) - (setq not-pref (car ihandles))) + (setq not-pref (or (cadr (member preferred ihandles)) + (car ihandles))) (when (or ibegend (not preferred) (not (gnus-unbuttonized-mime-type-p @@ -6164,22 +6170,22 @@ If nil, don't show those extra buttons." (progn (insert (format "%d. " id)) (point)) - `(gnus-callback - (lambda (handles) - (unless ,(not ibegend) - (setq gnus-article-mime-handle-alist - ',gnus-article-mime-handle-alist)) - (gnus-mime-display-alternative - ',ihandles ',not-pref ',begend ,id)) - keymap ,gnus-mime-button-map - mouse-face ,gnus-article-mouse-face - face ,gnus-article-button-face - follow-link t - gnus-part ,id - article-type multipart - rear-nonsticky t)) + (let ((gamha gnus-article-mime-handle-alist)) + `(gnus-callback + ,(lambda (_handles) + (unless (not ibegend) + (setq gnus-article-mime-handle-alist gamha)) + (gnus-mime-display-alternative + ihandles not-pref begend id)) + keymap ,gnus-mime-button-map + mouse-face ,gnus-article-mouse-face + face ,gnus-article-button-face + follow-link t + gnus-part ,id + article-type multipart + rear-nonsticky t))) ;; Do the handles - (while (setq handle (pop handles)) + (dolist (handle handles) (add-text-properties ;; (setq from (point) ;; ) @@ -6188,22 +6194,22 @@ If nil, don't show those extra buttons." (if (equal handle preferred) ?* ? ) (mm-handle-media-type handle))) (point)) - `(gnus-callback - (lambda (handles) - (unless ,(not ibegend) - (setq gnus-article-mime-handle-alist - ',gnus-article-mime-handle-alist)) - (gnus-mime-display-alternative - ',ihandles ',handle ',begend ,id)) - keymap ,gnus-mime-button-map - mouse-face ,gnus-article-mouse-face - face ,gnus-article-button-face - follow-link t - gnus-part ,id - button t - category t - gnus-data ,handle - rear-nonsticky t)) + (let ((gamha gnus-article-mime-handle-alist)) + `(gnus-callback + ,(lambda (_handles) + (unless (not ibegend) + (setq gnus-article-mime-handle-alist gamha)) + (gnus-mime-display-alternative + ihandles handle begend id)) + keymap ,gnus-mime-button-map + mouse-face ,gnus-article-mouse-face + face ,gnus-article-button-face + follow-link t + gnus-part ,id + button t + category t + gnus-data ,handle + rear-nonsticky t))) (insert " ")) (insert "\n\n")) (when preferred @@ -6308,7 +6314,8 @@ is the string to use when it is inactive.") (setq gnus-article-image-alist (delq entry gnus-article-image-alist)) (gnus-delete-wash-type category))) -(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) +(defalias 'gnus-article-hide-headers-if-wanted + #'gnus-article-maybe-hide-headers) (defun gnus-article-maybe-hide-headers () "Hide unwanted headers if `gnus-have-all-headers' is nil. @@ -6874,7 +6881,7 @@ then we display only bindings that start with that prefix." parent agent draft) (define-key keymap "S" map) (define-key map [t] nil) - (define-key summap [t] 'undefined) + (define-key summap [t] #'undefined) (with-current-buffer gnus-article-current-summary (dolist (key sumkeys) (define-key summap key (key-binding key (current-local-map)))) @@ -6910,10 +6917,11 @@ then we display only bindings that start with that prefix." (setq-local gnus-agent-summary-mode agent) (setq-local gnus-draft-mode draft) (describe-bindings prefix)) - (let ((item `((lambda (prefix) - (with-current-buffer ,(current-buffer) - (gnus-article-describe-bindings prefix))) - ,prefix))) + (let* ((cb (current-buffer)) + (item `(,(lambda (prefix) + (with-current-buffer cb + (gnus-article-describe-bindings prefix))) + ,prefix))) ;; Loading `help-mode' here is necessary if `describe-bindings' ;; is replaced with something, e.g. `helm-descbinds'. (require 'help-mode) @@ -8394,14 +8402,14 @@ url is put as the `gnus-button-url' overlay property on the button." (defvar gnus-prev-page-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'gnus-button-prev-page) - (define-key map "\r" 'gnus-button-prev-page) + (define-key map [mouse-2] #'gnus-button-prev-page) + (define-key map "\r" #'gnus-button-prev-page) map)) (defvar gnus-next-page-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'gnus-button-next-page) - (define-key map "\r" 'gnus-button-next-page) + (define-key map [mouse-2] #'gnus-button-next-page) + (define-key map "\r" #'gnus-button-next-page) map)) (defun gnus-insert-prev-page-button () @@ -8705,9 +8713,9 @@ For example: (defvar gnus-mime-security-button-map (let ((map (make-sparse-keymap))) - (define-key map "\r" 'gnus-article-push-button) - (define-key map [mouse-2] 'gnus-article-push-button) - (define-key map [down-mouse-3] 'gnus-mime-security-button-menu) + (define-key map "\r" #'gnus-article-push-button) + (define-key map [mouse-2] #'gnus-article-push-button) + (define-key map [down-mouse-3] #'gnus-mime-security-button-menu) (dolist (c gnus-mime-security-button-commands) (define-key map (cadr c) (car c))) map)) commit fb1c5e4816ae55cd8fc5387624a94c9c648f6f72 Author: João Távora Date: Tue May 25 22:40:40 2021 +0100 Add annotation capability to icomplete-vertical-mode Co-authored-by Daniel Mendler * lisp/icomplete.el (icomplete--affixate): New helper. (icomplete--render-vertical): Use it. Rework. (icomplete-completions): Pass md to icomplete--render-vertical. diff --git a/lisp/icomplete.el b/lisp/icomplete.el index f813a1776e..99896a4822 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -717,7 +717,30 @@ See `icomplete-mode' and `minibuffer-setup-hook'." (safe-length completion-all-sorted-completions)))))) (overlay-put icomplete-overlay 'after-string text)))))))) -(cl-defun icomplete--render-vertical (comps &aux scroll-above scroll-below) +(defun icomplete--affixate (md prospects) + "Affixate PROSPECTS given completion metadata MD. +Return a list of (COMP PREFIX SUFFIX)." + (let ((aff-fun (or (completion-metadata-get md 'affixation-function) + (plist-get completion-extra-properties :affixation-function))) + (ann-fun (or (completion-metadata-get md 'annotation-function) + (plist-get completion-extra-properties :annotation-function)))) + (cond (aff-fun + (funcall aff-fun prospects)) + (ann-fun + (mapcar + (lambda (comp) + (let ((suffix (or (funcall ann-fun comp) ""))) + (list comp "" + ;; The default completion UI adds the + ;; `completions-annotations' face if no + ;; other faces are present. + (if (text-property-not-all 0 (length suffix) 'face nil suffix) + suffix + (propertize suffix 'face 'completions-annotations))))) + prospects)) + (prospects)))) + +(cl-defun icomplete--render-vertical (comps md &aux scroll-above scroll-below) ;; Welcome to loopapalooza! ;; ;; First, be mindful of `icomplete-scroll' and manual scrolls. If @@ -771,14 +794,32 @@ See `icomplete-mode' and `minibuffer-setup-hook'." finally (setq scroll-below scroll-below-aux)) ;; Now figure out spacing and layout ;; - (let ((selected (substring (car comps)))) - (add-face-text-property 0 (length selected) - 'icomplete-selected-match 'append selected) - (concat " " icomplete-separator - (mapconcat - #'identity - (nconc scroll-above (list selected) scroll-below) - icomplete-separator)))) + (cl-loop + with selected = (substring (car comps)) + initially (add-face-text-property 0 (length selected) + 'icomplete-selected-match 'append selected) + with torender = (nconc scroll-above (list selected) scroll-below) + with triplets = (icomplete--affixate md torender) + initially (when (eq triplets torender) + (cl-return-from icomplete--render-vertical + (concat + " \n" + (mapconcat #'identity torender icomplete-separator)))) + for (comp prefix) in triplets + maximizing (length prefix) into max-prefix-len + maximizing (length comp) into max-comp-len + finally return + ;; Finally, render + ;; + (concat + " \n" + (cl-loop for (comp prefix suffix) in triplets + concat prefix + concat (make-string (- max-prefix-len (length prefix)) ? ) + concat comp + concat (make-string (- max-comp-len (length comp)) ? ) + concat suffix + concat icomplete-separator)))) ;;;_ > icomplete-completions (name candidates predicate require-match) (defun icomplete-completions (name candidates predicate require-match) @@ -824,7 +865,7 @@ matches exist." (progn ;;(debug (format "Candidates=%S field=%S" candidates name)) (format " %sNo matches%s" open-bracket close-bracket)) (if icomplete-vertical-mode - (icomplete--render-vertical comps) + (icomplete--render-vertical comps md) (let* ((last (if (consp comps) (last comps))) ;; Save the "base size" encoded in `comps' then ;; removing making `comps' a proper list. commit 05ab6e53e2cc82edb0b0916c880bdaa269267528 Author: João Távora Date: Sun May 30 16:26:02 2021 +0100 Improve icomplete-vertical-mode and fido-vertical-mode This mode is intended to be used with Icomplete ('M-x icomplete-mode') or Fido ('M-x fido-mode'), to display the list of completions candidates vertically instead of horizontally. When used with Icomplete, completions are rotated and selection kept at the top. When used with Fido, completions scroll like a typical dropdown widget. If the dropdown behaviour is desired for Icomplete (instead of rotation), icomplete-scroll can be adjusted separately by the user. * etc/NEWS (icomplete-vertical-mode): Reword. * lisp/icomplete.el (simple): Require it. (icomplete-selected-match): New face. (icomplete-scroll): New user-visible var. (icomplete-forward-completions): Rework. (icomplete-backward-completions): Rework. (icomplete--fido-mode-setup): Prefer icomplete-scroll according to icomplete-vertical mode. (icomplete-minibuffer-setup): Initialize icomplete--scrolled-completions. (fido-vertical-mode): An alias for icomplete-vertical-mode. (icomplete-exhibit): Init icomplete--scrolled-past. Adjust overlay. (icomplete--render-vertical): New helper. (icomplete--sorted-completions): If cache is stale, also invalidate icomplete--scrolled-past. (icomplete-completions): Rework. Mostly reformat. * lisp/simple.el (max-mini-window-lines): New helper. (display-message-or-buffer): Use it. diff --git a/etc/NEWS b/etc/NEWS index fe8789c60b..914e689032 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -534,9 +534,13 @@ indentation is done using SMIE or with the old ad-hoc code. ** Icomplete +++ -*** New minor mode 'icomplete-vertical-mode'. -This mode is intended to be used with Icomplete or Fido, to display the -list of completions candidates vertically instead of horizontally. +*** New minor mode 'icomplete-vertical-mode', alias 'fido-vertical-mode' +This mode is intended to be used with Icomplete ('M-x icomplete-mode') +or Fido ('M-x fido-mode'), to display the list of completions +candidates vertically instead of horizontally. When used with +Icomplete, completions are rotated and selection kept at the top. +When used with Fido, completions scroll like a typical dropdown +widget. --- ** Specific warnings can now be disabled from the warning buffer. diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 91bbb60013..f813a1776e 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -50,6 +50,8 @@ ;;; Code: (require 'rfn-eshadow) ; rfn-eshadow-overlay +(require 'simple) ; max-mini-window-lines +(require 'cl-lib) (defgroup icomplete nil "Show completions dynamically in minibuffer." @@ -99,6 +101,10 @@ Otherwise this should be a list of the completion tables (e.g., "Face used by Icomplete for highlighting first match." :version "24.4") +(defface icomplete-selected-match '((t :inherit highlight)) + "Face used by `icomplete-vertical-mode' for the selected candidate." + :version "24.4") + ;;;_* User Customization variables (defcustom icomplete-prospects-height 2 ;; We used to compute how many lines 100 characters would take in @@ -215,6 +221,29 @@ the default otherwise." ;; We're not at all interested in cycling here (bug#34077). (minibuffer-force-complete nil nil 'dont-cycle)) +;; Apropos `icomplete-scroll', we implement "scrolling icomplete" +;; within classic icomplete, which is "rotating", by contrast. +;; +;; The two variables supporing this are +;; `icomplete--scrolled-completions' and `icomplete--scrolled-past'. +;; They come into play when: +;; +;; - The user invokes commands `icomplete-forward-completions' and +;; `icomplete-backward-completions', thus "manually" scrolling to a +;; given position; +;; +;; - The user re-filters a selection that had already been manually +;; scrolled. The system attempts to keep the previous selection +;; stable in the face of the new filtering. This is mostly done in +;; `icomplete--render-vertical'. +;; +(defvar icomplete-scroll nil + "If non-nil, scroll candidates list instead of rotating it.") +(defvar icomplete--scrolled-completions nil + "If non-nil, tail of completions list manually scrolled to.") +(defvar icomplete--scrolled-past nil + "If non-nil, reverse tail of completions scrolled past.") + (defun icomplete-forward-completions () "Step forward completions by one entry. Second entry becomes the first and can be selected with @@ -223,10 +252,14 @@ Second entry becomes the first and can be selected with (let* ((beg (icomplete--field-beg)) (end (icomplete--field-end)) (comps (completion-all-sorted-completions beg end)) - (last (last comps))) - (when comps - (setcdr last (cons (car comps) (cdr last))) - (completion--cache-all-sorted-completions beg end (cdr comps))))) + (last (last comps))) + (when (consp (cdr comps)) + (cond (icomplete-scroll + (push (pop comps) icomplete--scrolled-past) + (setq icomplete--scrolled-completions comps)) + (t + (setcdr (last comps) (cons (pop comps) (cdr last))))) + (completion--cache-all-sorted-completions beg end comps)))) (defun icomplete-backward-completions () "Step backward completions by one entry. @@ -236,12 +269,16 @@ Last entry becomes the first and can be selected with (let* ((beg (icomplete--field-beg)) (end (icomplete--field-end)) (comps (completion-all-sorted-completions beg end)) - (last-but-one (last comps 2)) - (last (cdr last-but-one))) - (when (consp last) ; At least two elements in comps - (setcdr last-but-one (cdr last)) - (push (car last) comps) - (completion--cache-all-sorted-completions beg end comps)))) + last-but-one) + (cond ((and icomplete-scroll icomplete--scrolled-past) + (push (pop icomplete--scrolled-past) comps) + (setq icomplete--scrolled-completions comps)) + ((and (not icomplete-scroll) + (consp (cdr (setq last-but-one (last comps 2))))) + ;; At least two elements in comps + (push (car (cdr last-but-one)) comps) + (setcdr last-but-one (cdr (cdr last-but-one))))) + (completion--cache-all-sorted-completions beg end comps))) ;;; Helpers for `fido-mode' (or `ido-mode' emulation) ;;; @@ -351,6 +388,7 @@ if that doesn't produce a completion match." (setq-local icomplete-tidy-shadowed-file-names t icomplete-show-matches-on-no-input t icomplete-hide-common-prefix nil + icomplete-scroll (not (null icomplete-vertical-mode)) completion-styles '(flex) completion-flex-nospace nil completion-category-defaults nil @@ -449,6 +487,7 @@ Usually run by inclusion in `minibuffer-setup-hook'." (when (and icomplete-mode (icomplete-simple-completing-p)) (setq-local icomplete--initial-input (icomplete--field-string)) (setq-local completion-show-inline-help nil) + (setq icomplete--scrolled-completions nil) (use-local-map (make-composed-keymap icomplete-minibuffer-map (current-local-map))) (add-hook 'pre-command-hook #'icomplete-pre-command-hook nil t) @@ -483,6 +522,7 @@ Usually run by inclusion in `minibuffer-setup-hook'." (defun icomplete--sorted-completions () (or completion-all-sorted-completions (cl-loop + initially (setq icomplete--scrolled-past nil) ; Invalidate scrolled state with beg = (icomplete--field-beg) with end = (icomplete--field-end) with all = (completion-all-sorted-completions beg end) @@ -593,6 +633,8 @@ resized depends on `resize-mini-windows'." (add-hook 'icomplete-minibuffer-setup-hook #'icomplete--vertical-minibuffer-setup))) +(defalias 'fido-vertical-mode 'icomplete-vertical-mode) + @@ -659,13 +701,85 @@ See `icomplete-mode' and `minibuffer-setup-hook'." deactivate-mark) ;; Do nothing if while-no-input was aborted. (when (stringp text) - (move-overlay icomplete-overlay (point) (point) (current-buffer)) + (move-overlay icomplete-overlay (point-min) (point) (current-buffer)) ;; The current C cursor code doesn't know to use the overlay's ;; marker's stickiness to figure out whether to place the cursor ;; before or after the string, so let's spoon-feed it the pos. (put-text-property 0 1 'cursor t text) + (overlay-put + icomplete-overlay 'before-string + (and icomplete-scroll + (let ((past (length icomplete--scrolled-past))) + (format + "%s/%s " + (1+ past) + (+ past + (safe-length completion-all-sorted-completions)))))) (overlay-put icomplete-overlay 'after-string text)))))))) +(cl-defun icomplete--render-vertical (comps &aux scroll-above scroll-below) + ;; Welcome to loopapalooza! + ;; + ;; First, be mindful of `icomplete-scroll' and manual scrolls. If + ;; `icomplete--scrolled-completions' and `icomplete--scrolled-past' + ;; are: + ;; + ;; - both nil, there is no manual scroll; + ;; - both non-nil, there is a healthy manual scroll the doesn't need + ;; to be readjusted (user just moved around the minibuffer, for + ;; example)l + ;; - non-nil and nil, respectively, a refiltering took place and we + ;; need attempt to readjust them to the new filtered `comps'. + (when (and icomplete-scroll + icomplete--scrolled-completions + (null icomplete--scrolled-past)) + (cl-loop with preds + for (comp . rest) on comps + when (equal comp (car icomplete--scrolled-completions)) + do + (setq icomplete--scrolled-past preds + comps (cons comp rest)) + (completion--cache-all-sorted-completions + (icomplete--field-beg) + (icomplete--field-end) + comps) + and return nil + do (push comp preds) + finally (setq icomplete--scrolled-completions nil))) + ;; Then, in this pretty ugly loop, collect completions to display + ;; above and below the selected one, considering scrolling + ;; positions. + (cl-loop with preds = icomplete--scrolled-past + with succs = (cdr comps) + with max-lines = (1- (min + icomplete-prospects-height + (truncate (max-mini-window-lines) 1))) + with max-above = (- max-lines + 1 + (cl-loop for (_ . r) on comps + repeat (truncate max-lines 2) + while (listp r) + count 1)) + repeat max-lines + for neighbour = nil + if (and preds (> max-above 0)) do + (push (setq neighbour (pop preds)) scroll-above) + (cl-decf max-above) + else if (consp succs) collect + (setq neighbour (pop succs)) into scroll-below-aux + while neighbour + finally (setq scroll-below scroll-below-aux)) + ;; Now figure out spacing and layout + ;; + (let ((selected (substring (car comps)))) + (add-face-text-property 0 (length selected) + 'icomplete-selected-match 'append selected) + (concat " " icomplete-separator + (mapconcat + #'identity + (nconc scroll-above (list selected) scroll-below) + icomplete-separator)))) + ;;;_ > icomplete-completions (name candidates predicate require-match) (defun icomplete-completions (name candidates predicate require-match) "Identify prospective candidates for minibuffer completion. @@ -703,126 +817,126 @@ matches exist." predicate)) (md (completion--field-metadata (icomplete--field-beg))) (comps (icomplete--sorted-completions)) - (last (if (consp comps) (last comps))) - (base-size (cdr last)) (open-bracket (if require-match "(" "[")) (close-bracket (if require-match ")" "]"))) ;; `concat'/`mapconcat' is the slow part. (if (not (consp comps)) (progn ;;(debug (format "Candidates=%S field=%S" candidates name)) (format " %sNo matches%s" open-bracket close-bracket)) - (if last (setcdr last nil)) - (let* ((most-try - (if (and base-size (> base-size 0)) + (if icomplete-vertical-mode + (icomplete--render-vertical comps) + (let* ((last (if (consp comps) (last comps))) + ;; Save the "base size" encoded in `comps' then + ;; removing making `comps' a proper list. + (base-size (prog1 (cdr last) + (if last (setcdr last nil)))) + (most-try + (if (and base-size (> base-size 0)) + (completion-try-completion + name candidates predicate (length name) md) + ;; If the `comps' are 0-based, the result should be + ;; the same with `comps'. (completion-try-completion - name candidates predicate (length name) md) - ;; If the `comps' are 0-based, the result should be - ;; the same with `comps'. - (completion-try-completion - name comps nil (length name) md))) - (most (if (consp most-try) (car most-try) - (if most-try (car comps) ""))) - ;; Compare name and most, so we can determine if name is - ;; a prefix of most, or something else. - (compare (compare-strings name nil nil - most nil nil completion-ignore-case)) - (ellipsis (if (char-displayable-p ?…) "…" "...")) - (determ (unless (or (eq t compare) (eq t most-try) - (= (setq compare (1- (abs compare))) - (length most))) - (concat open-bracket - (cond - ((= compare (length name)) - ;; Typical case: name is a prefix. - (substring most compare)) - ;; Don't bother truncating if it doesn't gain - ;; us at least 2 columns. - ((< compare (+ 2 (string-width ellipsis))) most) - (t (concat ellipsis (substring most compare)))) - close-bracket))) - ;;"-prospects" - more than one candidate - (prospects-len (+ (string-width - (or determ (concat open-bracket close-bracket))) - (string-width icomplete-separator) - (+ 2 (string-width ellipsis)) ;; take {…} into account - (string-width (buffer-string)))) - (prospects-max - ;; Max total length to use, including the minibuffer content. - (* (+ icomplete-prospects-height - ;; If the minibuffer content already uses up more than - ;; one line, increase the allowable space accordingly. - (/ prospects-len (window-width))) - (window-width))) - ;; Find the common prefix among `comps'. - ;; We can't use the optimization below because its assumptions - ;; aren't always true, e.g. when completion-cycling (bug#10850): - ;; (if (eq t (compare-strings (car comps) nil (length most) - ;; most nil nil completion-ignore-case)) - ;; ;; Common case. - ;; (length most) - ;; Else, use try-completion. - (prefix (when icomplete-hide-common-prefix - (try-completion "" comps))) - (prefix-len - (and (stringp prefix) - ;; Only hide the prefix if the corresponding info - ;; is already displayed via `most'. - (string-prefix-p prefix most t) - (length prefix))) ;;) - prospects comp limit) - (if (or (eq most-try t) (not (consp (cdr comps)))) - (setq prospects nil) - (when (member name comps) - ;; NAME is complete but not unique. This scenario poses - ;; following UI issues: - ;; - ;; - When `icomplete-hide-common-prefix' is non-nil, NAME - ;; is stripped empty. This would make the entry - ;; inconspicuous. - ;; - ;; - Due to sorting of completions, NAME may not be the - ;; first of the prospects and could be hidden deep in - ;; the displayed string. - ;; - ;; - Because of `icomplete-prospects-height' , NAME may - ;; not even be displayed to the user. - ;; - ;; To circumvent all the above problems, provide a visual - ;; cue to the user via an "empty string" in the try - ;; completion field. - (setq determ (concat open-bracket "" close-bracket))) - ;; Compute prospects for display. - (while (and comps (not limit)) - (setq comp - (if prefix-len (substring (car comps) prefix-len) (car comps)) - comps (cdr comps)) - (setq prospects-len - (+ (string-width comp) - (string-width icomplete-separator) - prospects-len)) - (if (< prospects-len prospects-max) - (push comp prospects) - (setq limit t)))) - (setq prospects (nreverse prospects)) - ;; Decorate first of the prospects. - (when prospects - (let ((first (copy-sequence (pop prospects)))) - (put-text-property 0 (length first) - 'face 'icomplete-first-match first) - (push first prospects))) - ;; Restore the base-size info, since completion-all-sorted-completions - ;; is cached. - (if last (setcdr last base-size)) - (if prospects - (concat determ - (if icomplete-vertical-mode " \n" "{") - (mapconcat 'identity prospects (if icomplete-vertical-mode - "\n" - icomplete-separator)) - (unless icomplete-vertical-mode - (concat (and limit (concat icomplete-separator ellipsis)) - "}"))) - (concat determ " [Matched]")))))) + name comps nil (length name) md))) + (most (if (consp most-try) (car most-try) + (if most-try (car comps) ""))) + ;; Compare name and most, so we can determine if name is + ;; a prefix of most, or something else. + (compare (compare-strings name nil nil + most nil nil completion-ignore-case)) + (ellipsis (if (char-displayable-p ?…) "…" "...")) + (determ (unless (or (eq t compare) (eq t most-try) + (= (setq compare (1- (abs compare))) + (length most))) + (concat open-bracket + (cond + ((= compare (length name)) + ;; Typical case: name is a prefix. + (substring most compare)) + ;; Don't bother truncating if it doesn't gain + ;; us at least 2 columns. + ((< compare (+ 2 (string-width ellipsis))) most) + (t (concat ellipsis (substring most compare)))) + close-bracket))) + ;;"-prospects" - more than one candidate + (prospects-len (+ (string-width + (or determ (concat open-bracket close-bracket))) + (string-width icomplete-separator) + (+ 2 (string-width ellipsis)) ;; take {…} into account + (string-width (buffer-string)))) + (prospects-max + ;; Max total length to use, including the minibuffer content. + (* (+ icomplete-prospects-height + ;; If the minibuffer content already uses up more than + ;; one line, increase the allowable space accordingly. + (/ prospects-len (window-width))) + (window-width))) + ;; Find the common prefix among `comps'. + ;; We can't use the optimization below because its assumptions + ;; aren't always true, e.g. when completion-cycling (bug#10850): + ;; (if (eq t (compare-strings (car comps) nil (length most) + ;; most nil nil completion-ignore-case)) + ;; ;; Common case. + ;; (length most) + ;; Else, use try-completion. + (prefix (when icomplete-hide-common-prefix + (try-completion "" comps))) + (prefix-len + (and (stringp prefix) + ;; Only hide the prefix if the corresponding info + ;; is already displayed via `most'. + (string-prefix-p prefix most t) + (length prefix))) ;;) + prospects comp limit) + (prog1 + (if (or (eq most-try t) (and (not icomplete-scroll) + (not (consp (cdr comps))))) + (concat determ " [Matched]") + (when (member name comps) + ;; NAME is complete but not unique. This scenario poses + ;; following UI issues: + ;; + ;; - When `icomplete-hide-common-prefix' is non-nil, NAME + ;; is stripped empty. This would make the entry + ;; inconspicuous. + ;; + ;; - Due to sorting of completions, NAME may not be the + ;; first of the prospects and could be hidden deep in + ;; the displayed string. + ;; + ;; - Because of `icomplete-prospects-height' , NAME may + ;; not even be displayed to the user. + ;; + ;; To circumvent all the above problems, provide a visual + ;; cue to the user via an "empty string" in the try + ;; completion field. + (setq determ (concat open-bracket "" close-bracket))) + (while (and comps (not limit)) + (setq comp + (if prefix-len (substring (car comps) prefix-len) (car comps)) + comps (cdr comps)) + (setq prospects-len + (+ (string-width comp) + (string-width icomplete-separator) + prospects-len)) + (if (< prospects-len prospects-max) + (push comp prospects) + (setq limit t))) + (setq prospects (nreverse prospects)) + ;; Decorate first of the prospects. + (when prospects + (let ((first (copy-sequence (pop prospects)))) + (put-text-property 0 (length first) + 'face 'icomplete-first-match first) + (push first prospects))) + (concat determ + "{" + (mapconcat 'identity prospects icomplete-separator) + (concat (and limit (concat icomplete-separator ellipsis)) + "}"))) + ;; Restore the base-size info, since completion-all-sorted-completions + ;; is cached. + (if last (setcdr last base-size)))))))) ;;; Iswitchb compatibility diff --git a/lisp/simple.el b/lisp/simple.el index cdd77f74c3..6d216f74d9 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4217,12 +4217,22 @@ impose the use of a shell (with its need to quote arguments)." (shell-command-on-region (point) (point) command output-buffer nil error-buffer))))))) +(defun max-mini-window-lines (&optional frame) + "Compute maximum number of lines for echo area in FRAME. +As defined by `max-mini-window-height'. FRAME defaults to the +selected frame. Result may be a floating-point number, +i.e. include a fractional number of lines." + (cond ((floatp max-mini-window-height) (* (frame-height frame) + max-mini-window-height)) + ((integerp max-mini-window-height) max-mini-window-height) + (t 1))) + (defun display-message-or-buffer (message &optional buffer-name action frame) "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer. MESSAGE may be either a string or a buffer. A pop-up buffer is displayed using `display-buffer' if MESSAGE is too long -for maximum height of the echo area, as defined by `max-mini-window-height' +for maximum height of the echo area, as defined by `max-mini-window-lines' if `resize-mini-windows' is non-nil. Returns either the string shown in the echo area, or when a pop-up @@ -4261,14 +4271,7 @@ and are used only if a pop-up buffer is displayed." (cond ((= lines 0)) ((and (or (<= lines 1) (<= lines - (if resize-mini-windows - (cond ((floatp max-mini-window-height) - (* (frame-height) - max-mini-window-height)) - ((integerp max-mini-window-height) - max-mini-window-height) - (t - 1)) + (if resize-mini-windows (max-mini-window-lines) 1))) ;; Don't use the echo area if the output buffer is ;; already displayed in the selected frame.