[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/replace-region-contents ad708dc 2/2: Merge branch
|
From: |
Tassilo Horn |
|
Subject: |
[Emacs-diffs] scratch/replace-region-contents ad708dc 2/2: Merge branch 'origin/master' into scratch/replace-region-contents |
|
Date: |
Thu, 14 Feb 2019 12:43:00 -0500 (EST) |
branch: scratch/replace-region-contents
commit ad708dc1f2352b729db6e1ff7bc712a0239fb731
Merge: c3932c9 a4c7de3
Author: Tassilo Horn <address@hidden>
Commit: Tassilo Horn <address@hidden>
Merge branch 'origin/master' into scratch/replace-region-contents
---
doc/misc/eshell.texi | 3 +-
etc/NEWS | 8 ++-
lisp/emacs-lisp/rx.el | 57 ++++++++--------
lisp/international/ucs-normalize.el | 4 +-
lisp/ldefs-boot.el | 2 +-
lisp/minibuffer.el | 127 ++++++++++++++++++++++++++++++++++--
lisp/net/tramp-adb.el | 4 +-
lisp/progmodes/project.el | 2 +-
8 files changed, 168 insertions(+), 39 deletions(-)
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index dcb4aac..3540707 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -280,8 +280,7 @@ with no arguments, prints the current paths in this
variable.
@item alias
@cmindex alias
-Define an alias (@pxref{Aliases}). This does not add it to the aliases
-file.
+Define an alias (@pxref{Aliases}). This adds it to the aliases file.
@item clear
@cmindex clear
diff --git a/etc/NEWS b/etc/NEWS
index 75c8dc0..73332a8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -266,6 +266,12 @@ When non-nil, 'switch-to-buffer' uses
'pop-to-buffer-same-window' that
respects display actions specified by 'display-buffer-alist' and
'display-buffer-overriding-action'.
+** New 'flex' completion style
+An implementation of popular "flx/fuzzy/scatter" completion which
+matches strings where the pattern appears as a subsequence. Put
+simply, makes "foo" complete to both "barfoo" and "frodo". Add 'flex'
+to 'completion-styles' or 'completion-category-overrides' to use it.
+
* Editing Changes in Emacs 27.1
@@ -386,7 +392,7 @@ The mode is automatically enabled in files that start with
the
'function' keyword.
** project.el
-*** New commands 'project-search' and 'project-query-replace'.
+*** New commands 'project-search' and 'project-query-replace-regexp'.
** Etags
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index d00b868..b229903 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1,4 +1,4 @@
-;;; rx.el --- sexp notation for regular expressions
+;;; rx.el --- sexp notation for regular expressions -*- lexical-binding: t -*-
;; Copyright (C) 2001-2019 Free Software Foundation, Inc.
@@ -841,33 +841,34 @@ If FORM is `(minimal-match FORM1)', non-greedy versions
of `*',
(rx-group-if (cadr form) rx-parent))
-(defun rx-form (form &optional rx-parent)
+(defun rx-form (form &optional parent)
"Parse and produce code for regular expression FORM.
FORM is a regular expression in sexp form.
-RX-PARENT shows which type of expression calls and controls putting of
+PARENT shows which type of expression calls and controls putting of
shy groups around the result and some more in other functions."
- (cond
- ((stringp form)
- (rx-group-if (regexp-quote form)
- (if (and (eq rx-parent '*) (< 1 (length form)))
- rx-parent)))
- ((integerp form)
- (regexp-quote (char-to-string form)))
- ((symbolp form)
- (let ((info (rx-info form nil)))
- (cond ((stringp info)
- info)
- ((null info)
- (error "Unknown rx form `%s'" form))
- (t
- (funcall (nth 0 info) form)))))
- ((consp form)
- (let ((info (rx-info (car form) 'head)))
- (unless (consp info)
- (error "Unknown rx form `%s'" (car form)))
- (funcall (nth 0 info) form)))
- (t
- (error "rx syntax error at `%s'" form))))
+ (let ((rx-parent parent))
+ (cond
+ ((stringp form)
+ (rx-group-if (regexp-quote form)
+ (if (and (eq parent '*) (< 1 (length form)))
+ parent)))
+ ((integerp form)
+ (regexp-quote (char-to-string form)))
+ ((symbolp form)
+ (let ((info (rx-info form nil)))
+ (cond ((stringp info)
+ info)
+ ((null info)
+ (error "Unknown rx form `%s'" form))
+ (t
+ (funcall (nth 0 info) form)))))
+ ((consp form)
+ (let ((info (rx-info (car form) 'head)))
+ (unless (consp info)
+ (error "Unknown rx form `%s'" (car form)))
+ (funcall (nth 0 info) form)))
+ (t
+ (error "rx syntax error at `%s'" form)))))
;;;###autoload
@@ -1055,7 +1056,9 @@ CHAR
matches a character with category CATEGORY. CATEGORY must be
either a character to use for C, or one of the following symbols.
- `consonant' (\\c0 in string notation)
+ `space-for-indent' (\\c\\s in string notation)
+ `base' (\\c.)
+ `consonant' (\\c0)
`base-vowel' (\\c1)
`upper-diacritical-mark' (\\c2)
`lower-diacritical-mark' (\\c3)
@@ -1073,7 +1076,9 @@ CHAR
`japanese-hiragana-two-byte' (\\cH)
`indian-two-byte' (\\cI)
`japanese-katakana-two-byte' (\\cK)
+ `strong-left-to-right' (\\cL)
`korean-hangul-two-byte' (\\cN)
+ `strong-right-to-left' (\\cR)
`cyrillic-two-byte' (\\cY)
`combining-diacritic' (\\c^)
`ascii' (\\ca)
diff --git a/lisp/international/ucs-normalize.el
b/lisp/international/ucs-normalize.el
index 9d55470..6f1e770 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -109,7 +109,9 @@
(defconst ucs-normalize-version "1.2")
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'regexp-opt))
(declare-function nfd "ucs-normalize" (char))
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index b913b1b..a6c7669 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -26459,7 +26459,7 @@ To continue searching for next match, use command
\\[fileloop-continue].
\(fn REGEXP)" t nil)
-(autoload 'project-query-replace "project" "\
+(autoload 'project-query-replace-regexp "project" "\
Search for REGEXP in all the files of the project.
Stops when a match is found.
To continue searching for next match, use command \\[fileloop-continue].
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index b757eb8..cdbd4b3 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -788,6 +788,11 @@ Additionally the user can use the char \"*\" as a glob
pattern.")
I.e. when completing \"foo_bar\" (where _ is the position of point),
it will consider all completions candidates matching the glob
pattern \"*foo*bar*\".")
+ (flex
+ completion-flex-try-completion completion-flex-all-completions
+ "Completion of an in-order subset of characters.
+When completing \"foo\" the glob \"*f*o*o*\" is used, so that
+\"foo\" can complete to \"frodo\".")
(initials
completion-initials-try-completion completion-initials-all-completions
"Completion of acronyms and initialisms.
@@ -3037,6 +3042,22 @@ PATTERN is as returned by
`completion-pcm--string->pattern'."
(when (string-match-p regex c) (push c poss)))
(nreverse poss))))))
+(defvar flex-score-falloff -1.5
+ "Controls how the `flex' completion style scores its matches.
+
+Value is a number whose sign and amplitude have subtly different
+effects. Positive values make the scoring formula value matches
+scattered along the string, while negative values make the
+formula value tighter matches. I.e \"foo\" matches both strings
+\"barfoobaz\" and \"fabrobazo\", which are of equal length, but
+only a negative value will score the former higher than the
+second.
+
+The absolute value of this variable controls the relative order
+of different-length strings matched by the same pattern . Its
+effect is not completely understood yet, so feel free to play
+around with it.")
+
(defun completion-pcm--hilit-commonality (pattern completions)
(when completions
(let* ((re (completion-pcm--pattern->regex pattern 'group))
@@ -3051,8 +3072,45 @@ PATTERN is as returned by
`completion-pcm--string->pattern'."
(let* ((pos (if point-idx (match-beginning point-idx) (match-end 0)))
(md (match-data))
(start (pop md))
- (end (pop md)))
+ (end (pop md))
+ (len (length str))
+ ;; To understand how this works, consider these bad
+ ;; ascii(tm) diagrams showing how the pattern \"foo\"
+ ;; flex-matches \"fabrobazo" and
+ ;; \"barfoobaz\":
+
+ ;; f abr o baz o
+ ;; + --- + --- +
+
+ ;; bar foo baz
+ ;; --- +++ ---
+
+ ;; Where + indicates parts where the pattern matched,
+ ;; - where it didn't match. The score is a number
+ ;; bound by ]0..1]: the higher the better and only a
+ ;; perfect match (pattern equals string) will have
+ ;; score 1. The formula takes the form of a quotient.
+ ;; For the numerator, we use the number of +, i.e. the
+ ;; length of the pattern. For the denominator, it
+ ;; counts the number of - in each such group,
+ ;; exponentiates that number to `flex-score-falloff',
+ ;; adds it to the total, adds one to the final sum,
+ ;; and then multiples by the length of the string.
+ (score-numerator 0)
+ (score-denominator 0)
+ (last-b 0)
+ (update-score
+ (lambda (a b)
+ "Update score variables given match range (A B)."
+ (setq
+ score-numerator (+ score-numerator (- b a))
+ score-denominator (+ score-denominator
+ (expt (- a last-b)
+ flex-score-falloff))
+ last-b b))))
+ (funcall update-score 0 start)
(while md
+ (funcall update-score start (car md))
(put-text-property start (pop md)
'font-lock-face 'completions-common-part
str)
@@ -3060,11 +3118,16 @@ PATTERN is as returned by
`completion-pcm--string->pattern'."
(put-text-property start end
'font-lock-face 'completions-common-part
str)
+ (funcall update-score start end)
(if (> (length str) pos)
(put-text-property pos (1+ pos)
- 'font-lock-face 'completions-first-difference
- str)))
- str)
+ 'font-lock-face 'completions-first-difference
+ str))
+ (unless (zerop (length str))
+ (put-text-property
+ 0 1 'completion-score
+ (/ score-numerator (* len (1+ score-denominator)) 1.0) str)))
+ str)
completions))))
(defun completion-pcm--find-all-completions (string table pred point
@@ -3345,7 +3408,12 @@ the same set of elements."
;;; Substring completion
;; Mostly derived from the code of `basic' completion.
-(defun completion-substring--all-completions (string table pred point)
+(defun completion-substring--all-completions
+ (string table pred point &optional transform-pattern-fn)
+ "Match the presumed substring STRING to the entries in TABLE.
+Respect PRED and POINT. The pattern used is a PCM-style
+substring pattern, but it be massaged by TRANSFORM-PATTERN-FN, if
+that is non-nil."
(let* ((beforepoint (substring string 0 point))
(afterpoint (substring string point))
(bounds (completion-boundaries beforepoint table pred afterpoint))
@@ -3356,6 +3424,9 @@ the same set of elements."
(pattern (if (not (stringp (car basic-pattern)))
basic-pattern
(cons 'prefix basic-pattern)))
+ (pattern (if transform-pattern-fn
+ (funcall transform-pattern-fn pattern)
+ pattern))
(all (completion-pcm--all-completions prefix pattern table pred)))
(list all pattern prefix suffix (car bounds))))
@@ -3375,6 +3446,52 @@ the same set of elements."
(nconc (completion-pcm--hilit-commonality pattern all)
(length prefix)))))
+;;; "flex" completion, also known as flx/fuzzy/scatter completion
+;; Completes "foo" to "frodo" and "farfromsober"
+
+(defun completion-flex--make-flex-pattern (pattern)
+ "Convert PCM-style PATTERN into PCM-style flex pattern.
+
+This turns
+ (prefix \"foo\" point)
+into
+ (prefix \"f\" any \"o\" any \"o\" any point)
+which is at the core of flex logic. The extra
+'any' is optimized away later on."
+ (mapcan (lambda (elem)
+ (if (stringp elem)
+ (mapcan (lambda (char)
+ (list (string char) 'any))
+ elem)
+ (list elem)))
+ pattern))
+
+(defun completion-flex-try-completion (string table pred point)
+ "Try to flex-complete STRING in TABLE given PRED and POINT."
+ (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
+ (completion-substring--all-completions
+ string table pred point
+ #'completion-flex--make-flex-pattern)))
+ (if minibuffer-completing-file-name
+ (setq all (completion-pcm--filename-try-filter all)))
+ ;; Try some "merging", meaning add as much as possible to the
+ ;; user's pattern without losing any possible matches in `all'.
+ ;; i.e this will augment "cfi" to "config" if all candidates
+ ;; contain the substring "config". FIXME: this still won't
+ ;; augment "foo" to "froo" when matching "frodo" and
+ ;; "farfromsober".
+ (completion-pcm--merge-try pattern all prefix suffix)))
+
+(defun completion-flex-all-completions (string table pred point)
+ "Get flex-completions of STRING in TABLE, given PRED and POINT."
+ (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
+ (completion-substring--all-completions
+ string table pred point
+ #'completion-flex--make-flex-pattern)))
+ (when all
+ (nconc (completion-pcm--hilit-commonality pattern all)
+ (length prefix)))))
+
;; Initials completion
;; Complete /ums to /usr/monnier/src or lch to list-command-history.
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index f8b0505..22f2c5f 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -679,8 +679,8 @@ But handle the case, if the \"test\" command is not
available."
(current-time)
time)))
(tramp-adb-send-command-and-check
- v (format "touch -t %s %s"
- (format-time-string "%Y%m%d%H%M.%S" time)
+ v (format "touch -d %s %s"
+ (format-time-string "%Y-%m-%dT%H:%M:%S" time t)
(tramp-shell-quote-argument localname))))))
(defun tramp-adb-handle-copy-file
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index fbf761c..533e27b 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -532,7 +532,7 @@ To continue searching for next match, use command
\\[fileloop-continue]."
(fileloop-continue))
;;;###autoload
-(defun project-query-replace (from to)
+(defun project-query-replace-regexp (from to)
"Search for REGEXP in all the files of the project.
Stops when a match is found.
To continue searching for next match, use command \\[fileloop-continue]."