[elpa] externals/zones e5a839c: * zones.el: Silence compiler warnings

[Stefan Monnier]

branch: externals/zones
commit e5a839cbb6b72cfc8f09d388523f8c74e8829b5b
Author: Drew Adams 
Commit: Stefan Monnier 

* zones.el: Silence compiler warnings

(hlt-last-face, repeat-message-function)
(repeat-previous-repeated-command): Declare.
(zz-fringe-for-narrowing): Remove spurious * in docstring.
(zz-izones): Remove unused var `newval`.
(zz-zones-complement): Remove unused arg `buffer`.
(zz-zone-union): Don't forget to use `buffer`.
(zz-add-zone, zz-delete-zone, zz-unite-zones, narrow-to-defun):
Follow the _ convention for ignored vars.
(zz-markerize): Remove unused var `buf`.
(zz-string-match-p): Define in a way that the bytecompiler understands.
(zz-narrow-repeat, zz-select-region-repeat): Remove unused arg `arg`.
---
 zones.el | 188 +--
 1 file changed, 100 insertions(+), 88 deletions(-)

diff --git a/zones.el b/zones.el
index b106623..44d0323 100644
--- a/zones.el
+++ b/zones.el
@@ -6,11 +6,11 @@
 ;; Maintainer: Drew Adams
 ;; Copyright (C) 2010-2018, Drew Adams, all rights reserved.
 ;; Created: Sun Apr 18 12:58:07 2010 (-0700)
-;; Version: 2015-08-16
+;; Version: 2018-10-28
 ;; Package-Requires: ()
-;; Last-Updated: Sun Oct 21 11:52:29 2018 (-0700)
+;; Last-Updated: Sun Oct 28 18:46:30 2018 (-0700)
 ;;   By: dradams
-;; Update #: 2031
+;; Update #: 2075
 ;; URL: https://www.emacswiki.org/emacs/download/zones.el
 ;; Doc URL: https://www.emacswiki.org/emacs/Zones
 ;; Doc URL: https://www.emacswiki.org/emacs/MultipleNarrowings
@@ -19,7 +19,7 @@
 ;;
 ;; Features that might be required by this library:
 ;;
-;;   None
+;;   `backquote', `bytecomp', `cconv', `cl-lib', `macroexp'.
 ;;
 ;;
 ;;
@@ -31,7 +31,7 @@
 ;;
 ;;Bug reports etc.: (concat "drew" ".adams" "@" "oracle" ".com")
 ;;
- 
+
 ;;(@> "Index")
 ;;
 ;;  Index
@@ -55,7 +55,7 @@
 ;;(@> "Command `zz-narrow-repeat'")
 ;;(@> "Define Your Own Commands")
 ;;  (@> "Change log")
- 
+
 ;;(@* "Things Defined Here")
 ;;
 ;;  Things Defined Here
@@ -127,7 +127,7 @@
 ;;  `page.el' have been REDEFINED here:
 ;;
 ;;`narrow-to-defun', `narrow-to-page'.
- 
+
 ;;(@* "Documentation")
 ;;
 ;;  Documentation
@@ -246,7 +246,7 @@
 ;;  * Sort them.
 ;;
 ;;  * Unite (coalesce) adjacent or overlapping zones (which includes
-;;sorting them).
+;;sorting them in ascending order of their cars).
 ;;
 ;;  * Intersect them.
 ;;
@@ -461,7 +461,7 @@
 ;;  That's it - just iterate over `zz-izones' with a function that
 ;;  takes the region as an argument.  What `zones.el' offers in this
 ;;  regard is a way to easily define a set of buffer zones.
- 
+
 ;;
 ;;
 ;;; Change Log:
@@ -722,12 +722,15 @@
 (eval-when-compile (require 'cl)) ;; case
 
 ;; Quiet the byte-compiler.
+(defvar hlt-last-face)  ; In `highlight.el'
 (defvar mode-line-modes); Emacs 22+
 (defvar narrow-map) ; Emacs 23+
 (defvar region-extract-function); Emacs 25+
+(defvar repeat-message-function); In `repeat.el'
+(defvar repeat-previous-repeated-command) ; In `repeat.el'
 
 ;;
- 
+
 
 (defmacro zz-user-error (&rest args)
   `(if (fboundp 'user-error) (user-error ,@args) (error ,@args)))
@@ -751,7 +754,7 @@ Don't forget to mention your Emacs and library versions."))
   (defface zz-fringe-for-narrowing
   'background dark)) (:background "#2429FC15")) ; a dark magenta
 (t (:background "LightGreen")))
-"*Face used for fringe when buffer is narrowed."
+"Face used for fringe when buffer is narrowed."
 :group 'zones :group 'faces)
 
   (defcustom zz-narrowing-use-fringe-flag t
@@ -760,8 +763,8 @@ Don't forget to mention your Emacs and library versions."))
 :set (lambda (sym defs)
(custom-set-default sym defs)
(if (symbol-value sym)
-   (add-hook 'post-command-hook 'zz-set-fringe-for-narrowing)
- (remove-hook 'post-command-hook 'zz-set-fringe-for-narrowing
+   (add-hook 'post-command-hook #'zz-set-fringe-for-narrowing)
+ (remove-hook 'post-command-hook #'zz-set-fringe-for-narrowing
 
   (defun zz-set-fringe-for-narrowing ()
 "Set fringe face if buffer is narrowed."
@@ -796,8 +799,7 @@ converted to use the new format, with elements (NUM START 
END).
 
 This is a destructive operation.  The value of the variable is updated
 to use the new format, and that value is returned."
-  (let ((oldval  (symbol-value zz-izones-var))
-(newval  ()))
+  (let ((oldval  (symbol-value zz-izones-var)))
 (dolist (elt  oldval) (unless (consp (cddr elt)) (setcdr (cdr elt) (list 
(cddr elt)
 (symbol-value zz-izones-var)))
 
@@ -853,7 +855,7 @@ marker that points nowhere, then raise an error."
 (unless (equal buf1 buf2) (

[elpa] branch scratch/mheerdegen-preview deleted (was 0d07bb8)

[Michael Heerdegen]

mheerdegen pushed a change to branch scratch/mheerdegen-preview.

   was  0d07bb8   WIP: [el-search] Don't kill modified buffers

This change permanently discards the following revisions:

  discards  0d07bb8   WIP: [el-search] Don't kill modified buffers
  discards  9cfe823   WIP: [el-search] Enhance doc of el-search-occur-mode
  discards  8391d56   WIP: Small fix in el-search--changed-files-in-repo
  discards  fb5a73b   WIP: Small fix in 'el-search--reset-wrap-flag'
  discards  4900664   WIP: Fix C-A and C-J after finished single-buffer search
  discards  0e37f94   WIP: Add alarm-clock.el
  discards  c88c4c1   WIP: Include leading comments in occur defun context
  discards  6a048a7   WIP: Don't initially fold occur buffer
  discards  10e346c   WIP: [el-search] Some minor tweaks
  discards  d774bfe   WIP: Test: Make mouse clicks not abort the search
  discards  35edf10   WIP: Improvise eldoc support for search pattern prompt
  discards  2d15aa7   WIP: [el-search] Fine tune separator for splicing replace
  discards  19bbc05   WIP: More colorful match count
  discards  6de70fb   WIP: Improvements for change and changed
  discards  60fd31c   WIP [el-search] Adjust prev/next match commands for 
search and occur
  discards  9773b43   WIP [el-search] Fix search setup when occur flag bound
  discards  86f4f18   WIP [el-search] Fix C-j with numeric arg in error case
  discards  1020ca9   WIP: Optimize caching
  discards  08e0d20   WIP: Additions to "Mb hints"
  discards  1d22a6c   WIP [el-search] Minibuffer hints when entering pattern, 
Fix case when search pattern fails for some sexps
  discards  ffd1bb1   WIP [el-search] Discourage using symbols as LPATS in 
`append' and `l'
  discards  35be4f8   WIP [el-search] Fix more "redundant _ pattern" cases
  discards  3f656ab   WIP [el-search] Add quick help command
  discards  aca1cea   WIP [el-search] Implement 'el-search-keyboard-quit'
  discards  dc25f93   WIP: qr: Make shown replacement editable and ediffable; r 
twice restores match; stop for problematic comments
  discards  3c43b86   WIP: New command 'el-search-repository'
  discards  fa8dbb8   WIP: New file el-search/el-search-pp.el
  discards  ae9928e   WIP: Add el-search-hi-lock.el
  discards  fadf6f9   WIP: New :key arg for "filename" and new pattern types 
"file" and "dir"
  discards  0107628   WIP: New package "gnus-article-notes"
  discards  1fcb333   WIP: Add package "sscell"
  discards  a006107   WIP: Add diverse "sloppy" pattern types
  discards  efe4f41   WIP: [el-search] Fix nested match issues in *El Occur*

[elpa] scratch/mheerdegen-preview 9805060 02/35: WIP: [el-search] Fix nested match issues in *El Occur*

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 9805060e738713230706f66ee04e09a35a31cddb
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: [el-search] Fix nested match issues in *El Occur*

Fix flawed match count display and by-match moving in *El Occur*
buffers containing nested or adjacent matches.
---
 packages/el-search/el-search.el | 138 +---
 1 file changed, 73 insertions(+), 65 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index dbcb4ab..db5117d 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -405,11 +405,6 @@
 ;;   syntax "##" (a syntax for an interned symbol whose name is the
 ;;   empty string) can lead to errors while searching.
 ;;
-;; - In *El Occur* buffers, when there are adjacent or nested matches,
-;;   the movement commands (el-search-occur-previous-match,
-;;   el-search-occur-next-match aka n and p) may skip matches, and the
-;;   shown match count can be inaccurate.
-;;
 ;;
 ;; TODO:
 ;;
@@ -2998,43 +2993,40 @@ Prompt for a new pattern and revert."
   (add-hook 'post-command-hook #'el-search-hl-post-command-fun t t)
   (when do-fun (funcall do-fun)
 
+(defvar el-search-match-prop 'match-data)
+
 (defun el-search-occur--next-match (&optional backward)
-  (let ((done nil) (pos (point)))
-(when-let ((this-ov (cl-some (lambda (ov) (and (overlay-get ov 
'el-search-match) ov))
- (overlays-at pos
-  (setq pos (funcall (if backward #'overlay-start #'overlay-end) this-ov)))
-(while (and (not done) (setq pos (funcall (if backward 
#'previous-single-char-property-change
-
#'next-single-char-property-change)
-  pos 'el-search-match)))
-  (setq done (or (memq pos (list (point-min) (point-max)))
- (cl-some (lambda (ov) (overlay-get ov 'el-search-match))
-  (overlays-at pos)
-(if (memq pos (list (point-min) (point-max)))
+  (let ((pos (point)) new-pos)
+(cl-flet ((done (pos) (when-let ((match-nbr (get-char-property pos 
el-search-match-prop)))
+(and (not (= (point) (if backward (point-min) 
(point-max
+ (not (eq match-nbr
+  (get-char-property (1- pos) 
el-search-match-prop)))
+  (while (and (setq new-pos (funcall (if backward 
#'previous-single-char-property-change
+   #'next-single-char-property-change)
+ pos el-search-match-prop))
+  (not (eq pos new-pos))
+  (setq pos new-pos)
+  (not (done pos)
+(if (memq pos (list (point-min) (point-max) nil))
 (progn
   (el-search--message-no-log "No match %s this position" (if backward 
"before" "after"))
   (sit-for 1.5))
   (goto-char pos)
-  (save-excursion (hs-show-block
-  (el-search-occur--show-match-count))
+  (save-excursion (hs-show-block))
+  (redisplay)
+  (el-search--scroll-sexp-in-view (list (point) (el-search--end-of-sexp)))
+  (el-search-occur--show-match-count
 
 (defvar el-search-occur--total-matches nil)
 
 (defun el-search-occur--show-match-count ()
-  (while-no-input
-(let ((nbr-match 0)
-  (pos (point))
-  (match-here-p (lambda () (get-char-property (point) 
'el-search-match
-  (when (funcall match-here-p)
-(save-excursion
-  (save-restriction
-(widen)
-(goto-char (point-min))
-(while (< (point) pos)
-  (goto-char (next-single-char-property-change (point) 
'el-search-match))
-  (when (funcall match-here-p)
-(cl-incf nbr-match)))
-(el-search--message-no-log
- "Match %d/%d" nbr-match el-search-occur--total-matches)))
+  (pcase-let ((`(,_buffer ,_mb ,_file ,nbr)
+   (get-char-property (point) el-search-match-prop)))
+(el-search--message-no-log
+ "%d/%s" nbr
+ (if el-search-occur--total-matches
+ (format "%d" el-search-occur--total-matches)
+   "???"
 
 (defun el-search-occur-next-match ()
   "Move point to the next match."
@@ -3167,6 +3159,7 @@ Prompt for a new pattern and revert."
 (el-search--get-search-description-string search)))
 (condition-case-unless-debug err
 (let ((insert-summary-position (point))
+  (match-nbr 0)
   (stream-of-matches
(stream-partition
 (funcall (el-search-object-get-matches search))
@@ -3186,18 +3179,20 @@ Prompt for a new pattern and revert."
   (insert (format "  (%d match%s)\n"
   

[elpa] branch scratch/mheerdegen-preview created (now cdfaec4)

[Michael Heerdegen]

mheerdegen pushed a change to branch scratch/mheerdegen-preview.

at  cdfaec4   WIP: [el-search] Change default of 
el-search-use-prefix-key-transient-map to t

This branch includes the following new commits:

   new  76163ac   WIP: [el-search] Fix an infloop
   new  9805060   WIP: [el-search] Fix nested match issues in *El Occur*
   new  ee441a0   WIP: Add diverse "sloppy" pattern types
   new  220f349   WIP: Add package "sscell"
   new  44715aa   WIP: New package "gnus-article-notes"
   new  bef717d   WIP: New :key arg for "filename" and new pattern types 
"file" and "dir"
   new  b43f7bb   WIP: Add el-search-hi-lock.el
   new  2f72331   WIP: New file el-search/el-search-pp.el
   new  d2faca2   WIP: New command 'el-search-repository'
   new  c9e8efc   WIP: qr: Make shown replacement editable and ediffable; r 
twice restores match; stop for problematic comments
   new  b4b94b0   WIP [el-search] Implement 'el-search-keyboard-quit'
   new  f025458   WIP [el-search] Add quick help command
   new  f2ec15d   WIP [el-search] Fix more "redundant _ pattern" cases
   new  5057b57   WIP [el-search] Discourage using symbols as LPATS in 
`append' and `l'
   new  869266f   WIP [el-search] Minibuffer hints when entering pattern, 
Fix case when search pattern fails for some sexps
   new  82abecf   WIP: Additions to "Mb hints"
   new  f23fe5e   WIP: Optimize caching
   new  91f5bd3   WIP [el-search] Fix C-j with numeric arg in error case
   new  99782c3   WIP [el-search] Fix search setup when occur flag bound
   new  5e2aea1   WIP [el-search] Adjust prev/next match commands for 
search and occur
   new  df2132a   WIP: Improvements for change and changed
   new  2ec7a9e   WIP: More colorful match count
   new  feede7d   WIP: [el-search] Fine tune separator for splicing replace
   new  acc2594   WIP: Improvise eldoc support for search pattern prompt
   new  38def8b   WIP: Test: Make mouse clicks not abort the search
   new  c8d9698   WIP: [el-search] Some minor tweaks
   new  e706a2a   WIP: Don't initially fold occur buffer
   new  f1dde5c   WIP: Include leading comments in occur defun context
   new  c9085b6   WIP: Add alarm-clock.el
   new  7c82465   WIP: Fix C-A and C-J after finished single-buffer search
   new  e557155   WIP: Small fix in 'el-search--reset-wrap-flag'
   new  1f85214   WIP: Small fix in el-search--changed-files-in-repo
   new  237c2c6   WIP: [el-search] Enhance doc of el-search-occur-mode
   new  6ed849a   WIP: [el-search] Don't kill modified buffers
   new  cdfaec4   WIP: [el-search] Change default of 
el-search-use-prefix-key-transient-map to t

[elpa] scratch/mheerdegen-preview 2f72331 08/35: WIP: New file el-search/el-search-pp.el

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 2f72331f59671aff5ecad33c613960e0c86050d8
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: New file el-search/el-search-pp.el
---
 packages/el-search/el-search-pp.el | 135 +
 packages/el-search/el-search.el|  15 +++--
 2 files changed, 146 insertions(+), 4 deletions(-)

diff --git a/packages/el-search/el-search-pp.el 
b/packages/el-search/el-search-pp.el
new file mode 100644
index 000..053401f
--- /dev/null
+++ b/packages/el-search/el-search-pp.el
@@ -0,0 +1,135 @@
+;;; el-search-pp.el --- Further prettifications for pp with means of el-search 
-*- lexical-binding:t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc
+
+;; Author: Michael Heerdegen 
+;; Maintainer: Michael Heerdegen 
+;; Created: 2018_01_14
+;; Keywords: lisp
+
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see .
+
+
+;;; Commentary:
+
+;; This files provides a minor mode `el-search-pretty-pp-mode' that
+;; enhances pp.el to produce even prettier results.  Since
+;; el-search-query-replace uses pp to format replacement, this has
+;; also an effect on the insertions done by this command.
+;;
+;;
+;; Bugs, Known Limitations:
+;;
+;; This doesn't work with `cl-print'ed contents
+
+
+
+;;; Code:
+
+(require 'el-search)
+(require 'el-search-x)
+
+(defun el-search-prettify-let-likes ()
+  ;; Remove possible line break directly after the macro name
+  (let ((let-like-matcher (el-search-make-matcher 
el-search--match-let-like-pattern)))
+(save-excursion
+  (while (el-search--search-pattern-1 let-like-matcher t)
+(when (looking-at "(\\(\\_<\\(\\w\\|\\s_\\)+\\_>\\*?\\) *\n")
+  (save-excursion
+(goto-char (match-end 1))
+(delete-region
+ (point)
+ (progn (skip-chars-forward " \t\n") (point)))
+(insert " "))
+  (indent-sexp))
+(el-search--skip-expression nil 'read)
+
+(defun el-search-prettify-let-like-bindings ()
+  (let ((let-like-binding-matcher (el-search-make-matcher '(and 
(let-like-binding) `(,_ ,_)
+(save-excursion
+  (while (el-search--search-pattern-1 let-like-binding-matcher t)
+(let ((deleted-line-break nil))
+  (save-excursion
+(when (setq deleted-line-break
+(progn (down-list 1)
+   (goto-char (scan-sexps (point) 1))
+   (looking-at "[\s\t]*\n[\s\t]+")))
+  (delete-region (match-beginning 0) (match-end 0))
+  (insert " ")))
+  (when deleted-line-break (indent-sexp))
+  (el-search--skip-expression nil 'read))
+
+(defun el-search-prettify-huge-lists ()
+  (save-excursion
+(while (el-search--search-pattern-1 (el-search-make-matcher '(pred listp)) 
t nil)
+  (pcase-let ((`(,this-list ,bound) (save-excursion (list (el-search-read 
(current-buffer))
+  (copy-marker 
(point))
+(when (and (not (macrop (car this-list))) ; FIXME: find a solution for 
funs and macros
+   (or
+(< 60 (- bound (point)))
+(and
+ (null (cdr (last this-list))) ;FIXME: what about dotted 
or circular lists?
+ (nthcdr 10 this-list)
+ (not (cl-every (lambda (elt) (and (atom elt) (not 
(stringp elt
+this-list)
+  (save-excursion
+(down-list 1)
+(while (el-search-forward '_ bound t)
+  (goto-char (scan-sexps (point) 1))
+  (unless (or (looking-at "$") (not (save-excursion 
(el-search-forward '_ bound t
+(insert "\n"
+  (indent-sexp)))
+  (el-search--skip-expression nil 'read)))
+  (indent-sexp))
+
+(defun el-search-prettify-tiny-lists ()
+  (save-excursion
+(while (el-search--search-pattern-1 (el-search-make-matcher '(pred listp)) 
t nil)
+  (pcase-let ((bound (copy-marker (scan-sexps (point) 1
+(when (and (< (count-matches "[^[:space:]]" (point) bound) 45)
+   (save-excursion (search-forward-regexp "\n" bound t)))
+  (save-excursion
+(while (search-forward-regexp "\n[[:space:]]*" bound t)
+ 

[elpa] scratch/mheerdegen-preview 2ec7a9e 22/35: WIP: More colorful match count

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 2ec7a9eb3a01251126f4c2f879be249a2090c4e0
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: More colorful match count
---
 packages/el-search/el-search.el | 28 +---
 1 file changed, 17 insertions(+), 11 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 4e403b3..b0af521 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -2586,17 +2586,23 @@ created.")
 buffer-or-file
 matches-<=-here
 total-matches
-(propertize
- (format (pcase (save-excursion
-  (goto-char (car 
defun-bounds))
-  (el-search-read 
(current-buffer)))
-   (`(,a ,b . ,_) (format "(%s  
%%d/%%d)"
-  
(truncate-string-to-width
-   (format 
"%S %S" a b)
-   40 nil 
nil 'ellipsis)))
-   (_ "(%d/%d)"))
- matches-<=-here-in-defun 
total-matches-in-defun)
- 'face 'shadow
+(format
+ (pcase (save-excursion
+  (goto-char (car defun-bounds))
+  (and (el-search-looking-at '`(,_ 
,_ . ,_))
+   (let ((region (list
+  (progn 
(down-list) (point))
+  (min 
(line-end-position)
+   
(scan-sexps (point) 2)
+ (apply 
#'jit-lock-fontify-now region)
+ (apply #'buffer-substring 
region
+   ((and (pred stringp) signature)
+(format "(%s  %%d/%%d)"
+(truncate-string-to-width
+ signature
+ 40 nil nil 'ellipsis)))
+   (_ "(%d/%d)"))
+ matches-<=-here-in-defun 
total-matches-in-defun
  (list
   (concat (if (not just-count) "[Not at a match]   
" "")
   (if (= matches-<=-here total-matches)

[elpa] scratch/mheerdegen-preview 5057b57 14/35: WIP [el-search] Discourage using symbols as LPATS in `append' and `l'

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 5057b57db4e79eed6c4674132b9bd55163745eba
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP [el-search] Discourage using symbols as LPATS in `append' and `l'
---
 packages/el-search/el-search-x.el | 25 +
 1 file changed, 17 insertions(+), 8 deletions(-)

diff --git a/packages/el-search/el-search-x.el 
b/packages/el-search/el-search-x.el
index 03b3acf..30190c1 100644
--- a/packages/el-search/el-search-x.el
+++ b/packages/el-search/el-search-x.el
@@ -88,6 +88,14 @@ nil."
 list2 (cons (car last-list1) list2)
 match))
 
+(defun el-search-append--error-for-symbols (patterns &optional allowed-symbols)
+  (when-let ((symbol (cl-some (lambda (p) (and (symbolp p)
+   (not (keywordp p))
+   (not (memq p (append (list nil 
t '_) allowed-symbols)))
+   p))
+  patterns)))
+(user-error "Forbidden symbol binding: `%S'" symbol)))
+
 (el-search-defpattern append (&rest patterns)
   "Matches any list factorable into lists matched by PATTERNS in order.
 
@@ -97,16 +105,18 @@ equal to the concatenation of L1..Ln.  Ln is allowed to be 
no
 list.
 
 When different ways of matching are possible, it is unspecified
-which one is chosen.
+which one is chosen.  There is no backtracking, and trying to
+create symbol bindings in an `append' pattern form is forbidden.
 
 Example: the pattern
 
-   (append '(1 2 3) x (app car-safe 7))
+   (append '(1 2 3) _ (app car-safe 7))
 
-matches the list (1 2 3 4 5 6 7 8 9), binding `x' to (4 5 6)."
+matches the list (1 2 3 4 5 6 7 8 9)."
   (cond
((null patterns)   '(pred null))
((equal patterns '(_)) '(pred listp))
+   ((el-search-append--error-for-symbols patterns))
(t
 (pcase-let ((`(,pattern . ,more-patterns) patterns))
   (cond
@@ -163,11 +173,9 @@ __  Matches any number (including zero) of list 
elements.
 $   Matches zero elements, but only at the end of a list.
 Only allowed as the last of the LPATS.
 PAT Anything else is interpreted as a standard pattern and
-matches one list element matched by it.  Note: If
-matching PAT binds any symbols, occurrences in any
-following patterns are not turned into equivalence tests;
-the scope of symbol bindings is limited to the PAT
-itself.
+matches one list element matched by it.  Note: Since this
+pattern type doesn't implement backtracking, binding
+symbols in a PAT is discouraged.
 
 Example: To match defuns that contain \"hl\" in the defined name
 and have at least one mandatory, but also optional arguments, you
@@ -187,6 +195,7 @@ could use this pattern:
  (_ (funcall (el-search-heuristic-matcher 
(el-search--transform-nontrivial-lpat lpat))
  file-name-or-buffer atoms-thunk
  lpats)
+  (unless el-search-lazy-l (el-search-append--error-for-symbols lpats (list 
'__ '_ '_? '^ '$)))
   (let ((match-start nil) (match-end nil))
 (when (eq (car-safe lpats) '^)
   (setq match-start t)

[elpa] scratch/mheerdegen-preview f2ec15d 13/35: WIP [el-search] Fix more "redundant _ pattern" cases

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit f2ec15db5a48251f030d11bc0b10489168811264
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP [el-search] Fix more "redundant _ pattern" cases
---
 packages/el-search/el-search-x.el | 8 +---
 packages/el-search/el-search.el   | 2 +-
 2 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/packages/el-search/el-search-x.el 
b/packages/el-search/el-search-x.el
index a2f37c4..03b3acf 100644
--- a/packages/el-search/el-search-x.el
+++ b/packages/el-search/el-search-x.el
@@ -104,8 +104,10 @@ Example: the pattern
(append '(1 2 3) x (app car-safe 7))
 
 matches the list (1 2 3 4 5 6 7 8 9), binding `x' to (4 5 6)."
-  (if (null patterns)
-  '(pred null)
+  (cond
+   ((null patterns)   '(pred null))
+   ((equal patterns '(_)) '(pred listp))
+   (t
 (pcase-let ((`(,pattern . ,more-patterns) patterns))
   (cond
((null more-patterns) pattern)
@@ -115,7 +117,7 @@ matches the list (1 2 3 4 5 6 7 8 9), binding `x' to (4 5 
6)."
  (el-search-make-matcher pattern)
  (el-search-make-matcher (car 
more-patterns)))
`(,,pattern ,,(car more-patterns)
-   (t `(append ,pattern (append ,@more-patterns)))
+   (t `(append ,pattern (append ,@more-patterns
 
 (defcustom el-search-lazy-l t
   "Whether to interpret symbols and strings specially in `l'.
diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 9e55b9a..0b68741 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -1095,7 +1095,7 @@ N times."
  (defvar warning-suppress-log-types)
  (let ((byte-compile-debug t) ;make undefined pattern types raise an error
(warning-suppress-log-types '((bytecomp)))
-   (pattern-is-catchall (eq pattern '_)))
+   (pattern-is-catchall (and (symbolp pattern) (not (keywordp 
pattern)
(byte-compile
 `(lambda (,(if pattern-is-catchall '_ expression))
,(if pattern-is-catchall

[elpa] scratch/mheerdegen-preview feede7d 23/35: WIP: [el-search] Fine tune separator for splicing replace

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit feede7d8c8f2d77beb35806ffbfdcb64eb589628
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: [el-search] Fine tune separator for splicing replace
---
 packages/el-search/el-search.el | 6 +-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index b0af521..1ecfa8f 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -3959,7 +3959,11 @@ The return value is a marker pointing to the end of the 
replacement."
   (with-temp-buffer
 (emacs-lisp-mode)
 (insert (if splice
-(mapconcat #'el-search--pp-to-string replacement " ")
+(let ((insertions (mapcar #'el-search--pp-to-string 
replacement)))
+  (mapconcat #'identity insertions
+ (if (cl-some (apply-partially 
#'string-match-p "\n")
+  insertions)
+ "\n" " ")))
   (el-search--pp-to-string replacement)))
 (goto-char 1)
 (let (start this-sexp end orig-match-start orig-match-end done)

[elpa] scratch/mheerdegen-preview c9e8efc 10/35: WIP: qr: Make shown replacement editable and ediffable; r twice restores match; stop for problematic comments

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit c9e8efcab72fddf0d2fdd9c556a876c3df7e4575
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: qr: Make shown replacement editable and ediffable; r twice restores 
match; stop for problematic comments
---
 packages/el-search/el-search.el | 359 
 1 file changed, 254 insertions(+), 105 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 9d04be5..dd1ddf7 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -304,9 +304,10 @@
 ;;`(foo ,b ,a . ,rest) RET
 ;;
 ;; Type y to replace a match and go to the next one, r to replace
-;; without moving, SPC or n to go to the next match and ! to replace
-;; all remaining matches automatically.  q quits.  And ? shows a quick
-;; help summarizing all of these keys.
+;; without moving (hitting r again restores the match), SPC or n to go
+;; to the next match and ! to replace all remaining matches
+;; automatically.  q quits.  And ? shows a quick help summarizing all
+;; of these keys.
 ;;
 ;; It is possible to replace a match with an arbitrary number of
 ;; expressions using "splicing mode".  When it is active, the
@@ -314,6 +315,18 @@
 ;; the buffer for any match.  Hit s from the prompt to toggle splicing
 ;; mode in an `el-search-query-replace' session.
 ;;
+;; There are two ways to edit replacements while doing a query replace:
+;;
+;; (1) Without suspending the search: hit e from the query-replace
+;; prompt to edit the replacement string of the current replacement in
+;; a separate buffer, then hit C-c C-c when done.  This will make
+;; el-search insert the contents of this buffer for this replacement
+;; after confirmation.
+;;
+;; (2) At any time you can interrupt a query-replace session by
+;; hitting RET.  Make your edits, then resume the query-replace
+;; session by hitting C-S-j C-% or M-s e j %.
+;;
 ;;
 ;; Multi query-replace
 ;; ===
@@ -385,18 +398,6 @@
 ;;   to reading-printing.  "Some" because we can handle this problem
 ;;   in most cases.
 ;;
-;; - Similar: comments are normally preserved (where it makes sense).
-;;   But when replacing like `(foo ,a ,b) -> `(foo ,b ,a)
-;;
-;;   in a content like
-;;
-;; (foo
-;;   a
-;;   ;; comment
-;;   b)
-;;
-;;   the comment will be lost.
-;;
 ;; - Something like (1 #1#) is unmatchable (because it is un`read'able
 ;;   without context).
 ;;
@@ -429,10 +430,6 @@
 ;;   already suffice using only syntax tables, sexp scanning and
 ;;   font-lock?
 ;;
-;; - Replace: pause and warn when replacement might be wrong
-;;   (ambiguous reader syntaxes; lost comments, comments that can't
-;;   non-ambiguously be assigned to rewritten code)
-;;
 ;;
 ;; NEWS:
 ;;
@@ -541,6 +538,32 @@ The default value is ask-multi."
  (const :tag "Ask" ask)
  (const :tag "Ask when multibuffer" ask-multi)))
 
+(defcustom el-search-query-replace-stop-for-comments 'ask
+  "Whether `el-search-query-replace' should stop for problematic comments.
+
+It's not always clear how comments in a match should be mapped to
+the replacement.  If it can't be done automatically, the value of this
+option decides how to proceed in such a case.
+
+When nil, comments will likely be messed up or lost.  You should
+check the results after `el-search-query-replace' is done.
+
+A non-nil value means to stop when encountering problematic
+comments.  When the non-nil value is the symbol ask (the
+default), a prompt will appear that will ask how to proceed.  You
+may then choose to edit the replacement manually, or ignore the
+problem for this case to fix it later.
+
+Any other non-nil value will not prompt and just directly pop to
+a buffer where you can edit the replacement to adjust the
+comments.
+
+When ask, you can still choose the answer for all following cases
+from the prompt."
+  :type '(choice (const :tag "Off" nil)
+ (const :tag "On"  t)
+ (const :tag "Ask" ask)))
+
 (defvar el-search-use-transient-map nil
   "Whether el-search should make commands repeatable."
   ;; I originally wanted to make commands repeatable by looking at the
@@ -3599,7 +3622,9 @@ clone with an individual state."
 (defun el-search--replace-hunk (region to-insert)
   "Replace the text in REGION in current buffer with string TO-INSERT.
 Add line breaks before and after TO-INSERT when appropriate and
-reindent."
+reindent.
+
+The return value is a marker pointing to the end of the replacement."
   (atomic-change-group
 (let* ((inhibit-message t)
(message-log-max nil)
@@ -3634,23 +3659,24 @@ reindent."
   (insert to-insert)
   (when insert-newline-after
 (insert "\n"))
-  (if (string= to-insert "")
-  ;; We deleted the match.  Clean up.
-  (if (save-excursion (goto-char (line-beginning-position))
-  (looking-at (rx bol (* space) eol)))
-  

[elpa] scratch/mheerdegen-preview 76163ac 01/35: WIP: [el-search] Fix an infloop

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 76163ac5fe8d94d06b3d560b059d8a43066fcd57
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: [el-search] Fix an infloop
---
 packages/el-search/el-search.el | 11 +--
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index ff222b2..dbcb4ab 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -1138,12 +1138,11 @@ be specified as fourth argument, and COUNT becomes the 
fifth argument."
  ;; the thunk hasn't been forced
  (scan-lists (point) 1 0
  ((el-search--match-p matcher current-expr)
-  (setq match-beg
-(and (or (not bound)
- (<= (el-search--end-of-sexp match-beg) 
bound)
- ;; don't fail for >: a subsequent match 
may end before BOUND
- )
- (point
+  (if (or (not bound)
+  (<= (el-search--end-of-sexp match-beg) bound))
+  (setq match-beg (point))
+;; don't fail: a subsequent match may end before BOUND
+(el-search--skip-expression current-expr)))
  (t (el-search--skip-expression current-expr
   (when (and bound (<= bound (point)))
 (throw 'no-match t)))

[elpa] scratch/mheerdegen-preview acc2594 24/35: WIP: Improvise eldoc support for search pattern prompt

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit acc25944af6431ae10c383a47e0a47cf9fba041e
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Improvise eldoc support for search pattern prompt
---
 packages/el-search/el-search.el | 26 +-
 1 file changed, 25 insertions(+), 1 deletion(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 1ecfa8f..b86a775 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -916,6 +916,28 @@ nil."
 (timer-set-time el-search--mb-hints-timer (time-add (current-time) 
el-search-mb-hints-delay))
 (timer-activate el-search--mb-hints-timer)))
 
+(defun el-search-eldoc-documentation-function ()
+  (when (catch 'result
+  (save-excursion
+(while (condition-case nil
+   (progn (backward-up-list)
+  (if (el-search-looking-at '`(,(or 'pred 'guard) 
. ,_))
+  (throw 'result nil)
+t))
+ (scan-error nil)))
+t))
+(pcase-let (((and current-fsym `(,fnsym ,index))
+ (elisp--fnsym-in-current-sexp)))
+  (defvar el-search--pcase-macros) ;defined later
+  (let (pattern-def  help)
+(and fnsym
+ (setq pattern-def (cdr (assoc fnsym el-search--pcase-macros)))
+ (setq help (help-split-fundoc (documentation pattern-def) fnsym))
+ (elisp--highlight-function-argument
+  current-fsym
+  (format "%s" (cdar (read-from-string (car help
+  index (concat (symbol-name fnsym) ": ")))
+
 (defvar el-search--this-session-match-count-data nil)
 
 (defun el-search-read-pattern-setup-mb-hints ()
@@ -923,7 +945,9 @@ nil."
 (setq el-search--this-session-match-count-data nil)
 (when (timerp el-search--mb-hints-timer) (cancel-timer 
el-search--mb-hints-timer))
 (setq el-search--mb-hints-timer nil)
-(add-hook 'post-command-hook #'el-search-read-pattern-trigger-mb-hints t 
t)))
+(add-hook 'post-command-hook #'el-search-read-pattern-trigger-mb-hints t 
t))
+  (add-function :before-until (local 'eldoc-documentation-function)
+#'el-search-eldoc-documentation-function))
 
 (defvar el-search--search-pattern-1-do-fun nil)
 (defvar el-search--busy-animation

[elpa] scratch/mheerdegen-preview d2faca2 09/35: WIP: New command 'el-search-repository'

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit d2faca24155acdfd6498994a41db023ee49c97bb
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: New command 'el-search-repository'
---
 packages/el-search/el-search.el | 50 +
 1 file changed, 50 insertions(+)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 8838e33..9d04be5 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -3513,6 +3513,56 @@ related user options."
(lambda (search) (setf (alist-get 'description (el-search-object-properties 
search))
  "el-search-ibuffer-marked-files"
 
+(declare-function vc-read-revision 'vc)
+(declare-function vc-find-revision 'vc)
+(defun el-search-repository (repo revision pattern &optional file-regexp)
+  ;; FIXME: this is a stub.  Occur to-match-jumping doesn't work.
+  ;; Currently only works with git.  Slow.
+  (interactive (let* ((repo (let ((this-vc-root-dir (vc-root-dir)))
+  (expand-file-name
+   (read-directory-name "Repository root: "
+this-vc-root-dir 
this-vc-root-dir 'mustmatch
+  (result (list repo
+(read-string "Revision (leave empty for 
\"worktree\"): ")
+(read-string "File regexp: ")
+(el-search-read-pattern-for-interactive 
"Search pattern: "
+ (cl-rotatef (nth 2 result) (nth 3 result))
+ result))
+  (let ((just-worktree (or (not revision) (string= revision ""
+(el-search-setup-search
+ pattern
+ (lambda ()
+   (let* ((default-directory repo)
+  (files (seq-filter
+  #'el-search--elisp-file-p
+  (seq-filter
+   (if file-regexp
+   (lambda (fn) (string-match-p file-regexp fn))
+ #'el-search-true)
+   (mapcar #'expand-file-name
+   (split-string
+(shell-command-to-string
+ (if just-worktree
+ "git ls-files -z --recurse-submodules"
+   (format "git ls-tree --name-only -z -r %s 
--"
+   (shell-quote-argument revision
+"\0" t))
+ (seq-map (lambda (filename)
+(let ((default-directory repo))
+  (if just-worktree
+  filename
+(with-current-buffer
+(let ((inhibit-message t))
+  (vc-find-revision filename revision))
+  (setq-local el-search--temp-buffer-flag t)
+  (add-hook 'kill-buffer-hook
+(lambda ()
+  (when (file-exists-p buffer-file-name)
+(delete-file buffer-file-name)))
+'append 'local)
+  (current-buffer)
+  (stream files)))
+
  Register usage
 
 (defun el-search-to-register (register &optional el-search-object)

[elpa] scratch/mheerdegen-preview 44715aa 05/35: WIP: New package "gnus-article-notes"

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 44715aa23bc8c7c3c81d86af55447cfb5e657ff5
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: New package "gnus-article-notes"
---
 packages/gnus-article-notes/gnus-article-notes.el | 198 ++
 1 file changed, 198 insertions(+)

diff --git a/packages/gnus-article-notes/gnus-article-notes.el 
b/packages/gnus-article-notes/gnus-article-notes.el
new file mode 100644
index 000..299ca12
--- /dev/null
+++ b/packages/gnus-article-notes/gnus-article-notes.el
@@ -0,0 +1,198 @@
+;;; gnus-article-notes.el --- Attach notes to messages in Gnus   -*- 
lexical-binding: t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc
+
+;; Author: Michael Heerdegen 
+;; Maintainer: Michael Heerdegen 
+;; Created: 2017_12_11
+;; Keywords: news registry
+;; Version: 0.1
+;; Package-Requires: ()
+
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see .
+
+
+;;; Commentary:
+
+;; This simple package allows to attach text notes to articles in
+;; Gnus.  This is actually just a trivial convenience wrapper around
+;; `gnus-registry-set-id-key' and `gnus-registry-get-id-key'.
+;;
+;; For something less simplistic see the Gnorb package in Gnu Elpa.
+;; It can save notes in org files, track discussions, and much more.
+;;
+;;
+;; Usage
+;; =
+;;
+;; The main command is `gnus-article-notes-set-note' bound to "@" in
+;; the summary keymap.
+;;
+;; If the current article has not yet an attached note, hit @ to add
+;; one.  The article is also flagged with an "@" to indicate that a
+;; note has been attached.
+;;
+;; When an article has already an attached note, "@" displays the note
+;; in the echo area, and hitting "@" again let's you edit the note.
+;; "@" with a prefix argument 0 deletes the note after confirmation.
+;; "@" with any other prefix arg also reads in a note text but using a
+;; pop-up buffer instead of the minibuffer making editing multi-line
+;; notes more convenient.
+;;
+;;
+;; Setup
+;; =
+;;
+;; Somewhere in your initialization you need to enable the Gnus
+;; registry (where this package saves your notes), load this file, and
+;; make the key binding:
+;;
+;;   (gnus-registry-initialize)
+;;   (require 'gnus-article-notes)
+;;   (add-hook
+;;'gnus-summary-mode-hook
+;;(defun my-gnus-summary-mode-hook-bind-key-for-article-notes ()
+;;  (define-key gnus-summary-mode-map [?@] #'gnus-article-notes-set-note)))
+;;
+;; It is a good idea to read about what enabling the registry means if
+;; you haven't yet used it: (info "(gnus) The Gnus Registry").  It is
+;; easy stuff.  You may want to limit how much data Gnus stores in the
+;; registry to avoid delays when saving (it stores a lot by default).
+;; I do (setq gnus-registry-max-entries 2000).  Note that pruning a
+;; full registry will never delete notes unless you change
+;; `gnus-registry-extra-entries-precious' to not contain `mark'.
+;; Loading this package adds a "Note" named custom mark to
+;; `gnus-registry-marks' (by default).
+;;
+;; To see the "@" marker for messages with attached notes in the
+;; summary buffer, you also want something like
+;;
+;;   (defalias 'gnus-user-format-function-M
+;; 'gnus-registry-article-marks-to-chars)
+;;
+;; which allows you to use "%uM" (or better with a padding like in
+;; "%2uM") in `gnus-summary-line-format' to show registry marks - see
+;; (info "(gnus) Store custom flags and keywords") for details.
+;;
+;; Finally you may also want to look at the few customizable options
+;; defined in this file.
+
+
+
+;;; Code:
+
+
+
+(eval-when-compile (require 'subr-x))
+(require 'gnus)
+(require 'gnus-registry)
+
+(defvar gnus-article-notes-registry-field 'Note)
+(defvar gnus-article-notes-marker-char ?@)
+(defvar gnus-article-notes-auto-tick nil)
+
+(defvar gnus-article-notes-show-in-summary t)
+
+(defun gnus-article-notes-registry-delete-id-key (id key)
+  (let* ((db gnus-registry-db)
+ (entry (gnus-registry-get-or-make-entry id)))
+(registry-delete db (list id) nil)
+(setq entry (assq-delete-all key entry))
+(gnus-registry-insert db id entry)
+entry))
+
+(with-eval-after-load 'gnus-registry
+  (add-to-list 'gnus-registry-marks
+   `(,gnus-article-notes-registry-field :char 
,gnus-article-notes-marker-char :image nil)))
+
+(defvar gnus-article-notes-popup-window-action '())
+

[elpa] scratch/mheerdegen-preview f1dde5c 28/35: WIP: Include leading comments in occur defun context

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit f1dde5c309975f93e4032b00ad796d01dfa63667
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Include leading comments in occur defun context
---
 packages/el-search/el-search.el | 11 ++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index acebf86..13d553d 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -3521,7 +3521,16 @@ Prompt for a new pattern and revert."
 (el-search--end-of-sexp match-beg)
 
 (defun el-search-occur-get-defun-context (match-beg)
-  (el-search--bounds-of-defun match-beg))
+  (let ((bounds (el-search--bounds-of-defun match-beg)))
+(save-excursion
+  (goto-char (car bounds))
+  (unless (bobp)
+(forward-line -1)
+(while (and (not (bobp))
+(looking-at "[[:space:]]*;"))
+  (setf (car bounds) (point))
+  (forward-line -1
+bounds))
 
 (defun el-search-occur-get-null-context (match-beg)
   (cons match-beg (el-search--end-of-sexp match-beg)))

[elpa] scratch/mheerdegen-preview 1f85214 32/35: WIP: Small fix in el-search--changed-files-in-repo

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 1f852142ce2fc58f9a46576180b5153baf07b0c6
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Small fix in el-search--changed-files-in-repo

Make semantics analogue to 'el-search--file-changed-p'.
---
 packages/el-search/el-search-x.el | 24 
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/packages/el-search/el-search-x.el 
b/packages/el-search/el-search-x.el
index 5b84cb9..e7fa959 100644
--- a/packages/el-search/el-search-x.el
+++ b/packages/el-search/el-search-x.el
@@ -244,14 +244,22 @@ The default value is nil."
   "Return a list of files that changed relative to COMMIT.
 COMMIT defaults to HEAD."
   (cl-callf or commit "HEAD")
-  (let ((default-directory repo-root-dir))
-(mapcar #'expand-file-name
-(split-string
- (let ((current-message (current-message)))
-   (with-temp-message (concat current-message "  [Running Git...]")
- (shell-command-to-string
-  (format "git diff -z --name-only %s --" 
(shell-quote-argument commit)
- "\0" t
+  (let ((default-directory repo-root-dir)
+(message-log-max nil)
+(current-message (current-message)))
+(with-temp-message (concat current-message "  [Running Git...]")
+  (mapcar #'expand-file-name
+  (cl-nintersection
+   (split-string
+(shell-command-to-string
+ (format "git diff -z --name-only %s --" (shell-quote-argument 
commit)))
+"\0" t)
+   (split-string
+(shell-command-to-string
+ (format "git diff -z --name-only 
4b825dc642cb6eb9a060e54bf8d69288fbee4904 %s --"
+ (shell-quote-argument commit)))
+"\0" t)
+   :test #'equal)
 
 (defvar vc-git-diff-switches)
 (defun el-search--file-changed-p (file revision)

[elpa] scratch/mheerdegen-preview f23fe5e 17/35: WIP: Optimize caching

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit f23fe5e312ca4368efae7ba78b08c3ea266187c9
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Optimize caching
---
 packages/el-search/el-search.el | 48 +
 1 file changed, 29 insertions(+), 19 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 79de021..d9791d0 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -1649,8 +1649,8 @@ PATTERN and combining the heuristic matchers of the 
subpatterns."
   (walker tree)
   elements)))
 
-(defun el-search-heuristic-buffer-matcher (pattern)
-  (let ((heuristic-matcher (el-search-heuristic-matcher pattern)))
+(defun el-search-heuristic-buffer-matcher (pattern &optional hm)
+  (let ((heuristic-matcher (or hm (el-search-heuristic-matcher pattern
 (lambda (file-name-or-buffer)
   (el-search--message-no-log "%s"
  (if (stringp file-name-or-buffer)
@@ -1790,7 +1790,7 @@ With ALLOW-LEADING-WHITESPACE non-nil, the match may
 be preceded by whitespace."
   (el-search--looking-at-1 (el-search-make-matcher pattern) 
allow-leading-whitespace))
 
-(defun el-search--all-matches (search)
+(defun el-search--all-matches (search &optional dont-copy)
   "Return a stream of all matches of SEARCH.
 The returned stream will always start searching from the
 beginning anew even when SEARCH has been used interactively or
@@ -1804,7 +1804,7 @@ The elements of the returned stream will have the form
 where BUFFER or FILE is the buffer or file where a match has been
 found (exactly one of the two will be nil), and MATCH-BEG is the
 position of the beginning of the match."
-  (let* ((search (el-search-reset-search (copy-el-search-object search)))
+  (let* ((search (if dont-copy search (el-search-reset-search 
(copy-el-search-object search
  (head (el-search-object-head search)))
 (seq-filter
  #'identity ;we use `nil' as a "skip" tag
@@ -1849,7 +1849,9 @@ position of the beginning of the match."
   (setf (el-search-head-heuristic-matcher head)
 (el-search-heuristic-matcher pattern))
   (setf (el-search-head-heuristic-buffer-matcher head)
-(el-search-heuristic-buffer-matcher pattern))
+(el-search-heuristic-buffer-matcher
+ pattern
+ (el-search-head-heuristic-matcher head)))
   head)
 
 (defun el-search-compile-pattern-in-search (search)
@@ -2513,18 +2515,26 @@ created.")
  (_
   ;; (message "Refreshing match count data") (sit-for 1)
   (redisplay) ;don't delay highlighting
-  (setq-local el-search--buffer-match-count-data
-  (let ((stream-of-buffer-matches
- (seq-map #'cadr
-  (el-search--all-matches
-   (el-search-make-search
-
(el-search--current-pattern)
-(let ((current-buffer 
(current-buffer)))
-  (lambda () (stream (list 
current-buffer)
-(list
- el-search--current-search
- (buffer-chars-modified-tick)
- stream-of-buffer-matches)))
+  (let ((new-search (el-search-make-search
+ (el-search--current-pattern)
+ (let ((current-buffer 
(current-buffer)))
+   (lambda () (stream (list 
current-buffer)))
+(let ((head (el-search-object-head new-search)))
+  ;; reuse already existing heuristic matchers
+  (setf (el-search-head-heuristic-matcher head)
+(el-search-head-heuristic-matcher
+ (el-search-object-head 
el-search--current-search)))
+  (setf (el-search-head-heuristic-buffer-matcher head)
+(el-search-head-heuristic-buffer-matcher
+ (el-search-object-head 
el-search--current-search
+(setq-local el-search--buffer-match-count-data
+(let ((stream-of-buffer-matches
+   (seq-map #'cadr
+(el-search--all-matches 
new-search 'dont-copy
+  (list
+   el-search--current-search
+   (buffer-chars-modified-tick)
+   stream-of

[elpa] scratch/mheerdegen-preview e557155 31/35: WIP: Small fix in 'el-search--reset-wrap-flag'

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit e5571552b1b454584cedd0385f083d383e31e008
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Small fix in 'el-search--reset-wrap-flag'
---
 packages/el-search/el-search.el | 6 --
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index c06f953..8739425 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -2743,8 +2743,10 @@ local binding of `window-scroll-functions'."
   (memq #'el-search-hl-post-command-fun post-command-hook))
 
 (defun el-search--reset-wrap-flag ()
-  (unless (or (eq this-command 'el-search-query-replace)
-  (eq this-command 'el-search-pattern))
+  (unless (eq real-this-command
+  (if (eq el-search--wrap-flag 'forward)
+  'el-search-pattern
+'el-search-pattern-backward))
 (remove-hook 'post-command-hook 'el-search--reset-wrap-flag)
 (setq el-search--wrap-flag nil)))
 

[elpa] scratch/mheerdegen-preview ee441a0 03/35: WIP: Add diverse "sloppy" pattern types

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit ee441a0bdc290c6751679e1e6814d17f550e023f
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Add diverse "sloppy" pattern types
---
 packages/el-search/el-search-x.el | 74 +++
 1 file changed, 74 insertions(+)

diff --git a/packages/el-search/el-search-x.el 
b/packages/el-search/el-search-x.el
index 0af955c..a2f37c4 100644
--- a/packages/el-search/el-search-x.el
+++ b/packages/el-search/el-search-x.el
@@ -39,6 +39,15 @@
 (require 'thunk)
 (require 'el-search)
 
+(el-search-defpattern quoted (&optional pattern)
+  "Matches 'X, #'X and `X when X is matched by PATTERN."
+  (cl-callf or pattern '_)
+  `(or `',,pattern `#',,pattern `(,,''\` ,,pattern)))
+
+(el-search-defpattern maybe-quoted (&optional pattern)
+  "Matches X, 'X, #'X and `X when X is matched by PATTERN."
+  (cl-callf or pattern '_)
+  `(or ,pattern (quoted ,pattern)))
 
 (el-search-defpattern string-lines (pattern)
   "Matches any string whose line count is matched by PATTERN.
@@ -409,6 +418,12 @@ expression matching the `change' pattern will be matched."
   "Matches any toplevel expression."
   '(outermost _))
 
+(el-search-defpattern innermost (pattern &optional not-pattern)
+  "Matches PATTERN but not lists containing a matching element.
+
+With NOT-PATTERN given, match anything matched by the PATTERN
+except for lists containing an element matched by NOT-PATTERN."
+  `(and ,pattern (not (append _ `(,,(or not-pattern pattern)) _
 
 ;;; Sloppy pattern types for quick navigation
 
@@ -446,6 +461,65 @@ matches any of these expressions:
"keys" (list key-sequence) (lambda (x) (or (stringp x) (vectorp x))) 
"argument not a string or vector")
   `(pred (el-search--match-key-sequence ,key-sequence)))
 
+(el-search-defpattern define-key (&optional map keys def)
+  `(l ^ (symbol "key\\'")
+  ,(if (memq map '(_ nil)) '_? map)
+  ,(or keys '_)
+  ,@(when def `(,def
+
+(el-search-defpattern def--1 (type &optional name &rest lpats)
+  (when (and name (not (eq name '_)))
+(let ((pattern (el-search--transform-nontrivial-lpat name)))
+  (setq name `(or ,pattern `',,pattern
+  (setq lpats (if (or name lpats) (cons name lpats) nil))
+  (if type
+  `(l ^ ,type ,@lpats)
+`(or (l ^ (symbol "def") ,@lpats)
+ ;; cl-defstruct
+ (l ^ (symbol "defstruct") (l ^ ,(car lpats)) ,@(cdr lpats)
+
+(el-search-defpattern def (&optional name &rest lpats)
+  "Match definitions.
+NAME, when given, is an lpat that must match the defined name.
+The remaining LPATS are like in the \"l\" pattern."
+  `(def--1 nil ,name . ,lpats))
+
+(el-search-defpattern defun (&optional name &rest lpats)
+  "Like \"def\" but matches only defuns."
+  `(def--1 (or 'defun 'cl-defun 'defsubst) ,name . ,lpats))
+
+(el-search-defpattern defmacro (&optional name &rest lpats)
+  "Like \"def\" but matches only defuns."
+  `(def--1 (or 'defmacro 'cl-defmacro) ,name . ,lpats))
+
+(el-search-defpattern defvar (&optional name &rest lpats)
+  "Like \"def\" but matches only defvars."
+  `(def--1 (or 'defvar 'defcustom 'defvar-local) ,name . ,lpats))
+
+(el-search-defpattern defface (&optional name &rest lpats)
+  "Like \"def\" but matches only `defface' expressions."
+  `(def--1 'defface ,name . ,lpats))
+
+(el-search-defpattern defmethod (&optional name &rest lpats)
+  `(def--1 (or 'defmethod 'cl-defmethod) ,name . ,lpats))
+
+(el-search-defpattern command (&optional name &rest lpats)
+  "Like \"def\" but matches only defuns with an `interactive' spec."
+  (cl-callf or name '_)
+  `(and (def ,name ,@lpats)
+(or `(defun ,_ . ,(pred (cl-some (lambda (elt) (eq (car-safe elt) 
'interactive)
+`(,(symbol "def" "mode$") . ,_
+
+(el-search-defpattern undocumented (&optional name)
+  "Heuristically search for definitions missing documentation.
+With pattern NAME given, match it against the symbol defined."
+  (let ((expr (make-symbol "this-expression"))
+(elt  (make-symbol "elt")))
+`(and (def ,(or name '_))
+  (pred (lambda (,expr)
+  ;; Don't accept something like "Todo" or "$$$FIXME" or "..."
+  (not (cl-some (lambda (,elt) (and (stringp ,elt) (< 15 
(length ,elt ,expr)))
+
 
 
 ;;; Patterns for stylistic rewriting and syntactical simplification

[elpa] scratch/mheerdegen-preview df2132a 21/35: WIP: Improvements for change and changed

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit df2132a0c2a4c6979de90102e48d2f45566fbcd0
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Improvements for change and changed

squash! WIP: change, changed: only user-error in interactive case
---
 packages/el-search/el-search-x.el | 72 ++-
 1 file changed, 41 insertions(+), 31 deletions(-)

diff --git a/packages/el-search/el-search-x.el 
b/packages/el-search/el-search-x.el
index 30190c1..1a40322 100644
--- a/packages/el-search/el-search-x.el
+++ b/packages/el-search/el-search-x.el
@@ -307,37 +307,41 @@ Uses variable `el-search--cached-changes' for caching."
 
 (defun el-search--change-p (posn revision)
   ;; Non-nil when sexp after POSN is part of a change
-  (when (buffer-modified-p)
-(user-error "Buffer is modified - please save"))
-  (save-restriction
-(widen)
-(let ((changes (el-search--changes-from-diff-hl revision))
-  (sexp-end (el-search--end-of-sexp posn))
-  (atomic? (thunk-delay (el-search--atomic-p
- (save-excursion (goto-char posn)
- (el-search-read 
(current-buffer)))
-  (while (and changes (or (< (cdar changes) posn)
-  (and
-   ;; a string spanning multiple lines is a change 
even when not all
-   ;; lines are changed
-   (< (cdar changes) sexp-end)
-   (not (thunk-force atomic?)
-(pop changes))
-  (and changes (or (<= (caar changes) posn)
-   (and (thunk-force atomic?)
-(<= (caar changes) sexp-end)))
+  (if (buffer-modified-p)
+  (if (eq this-command 'el-search-pattern)
+  (user-error "Buffer is modified - please save")
+nil)
+(save-restriction
+  (widen)
+  (let ((changes (el-search--changes-from-diff-hl revision))
+(sexp-end (el-search--end-of-sexp posn))
+(atomic? (thunk-delay (el-search--atomic-p
+   (save-excursion (goto-char posn)
+   (el-search-read 
(current-buffer)))
+(while (and changes (or (< (cdar changes) posn)
+(and
+ ;; a string spanning multiple lines is a 
change even when not all
+ ;; lines are changed
+ (< (cdar changes) sexp-end)
+ (not (thunk-force atomic?)
+  (pop changes))
+(and changes (or (<= (caar changes) posn)
+ (and (thunk-force atomic?)
+  (<= (caar changes) sexp-end
 
 (defun el-search--changed-p (posn revision)
   ;; Non-nil when sexp after POSN contains a change
-  (when (buffer-modified-p)
-(user-error "Buffer is modified - please save"))
-  (save-restriction
-(widen)
-(let ((changes (el-search--changes-from-diff-hl revision)))
-  (while (and changes (<= (cdar changes) posn))
-(pop changes))
-  (and changes
-   (< (caar changes) (el-search--end-of-sexp posn))
+  (if (buffer-modified-p)
+  (if (eq this-command 'el-search-pattern)
+  (user-error "Buffer is modified - please save")
+nil)
+(save-restriction
+  (widen)
+  (let ((changes (el-search--changes-from-diff-hl revision)))
+(while (and changes (<= (cdar changes) posn))
+  (pop changes))
+(and changes
+ (< (caar changes) (el-search--end-of-sexp posn)))
 
 (defun el-search-change--heuristic-matcher (&optional revision)
   (let* ((revision (or revision "HEAD"))
@@ -369,6 +373,10 @@ Uses variable `el-search--cached-changes' for caching."
  revision file))
 (lambda (file-name-or-buffer _) (funcall file-changed-p 
file-name-or-buffer
 
+(el-search-defpattern change--1 (&optional revision)
+  (declare (heuristic-matcher #'el-search-change--heuristic-matcher))
+  `(guard (el-search--change-p (point) ,(or revision "HEAD"
+
 (el-search-defpattern change (&optional revision)
   "Matches the object if its text is part of a file change.
 
@@ -379,8 +387,11 @@ REVISION is interpreted.
 
 This pattern-type does currently only work for git versioned
 files."
+  `(and (filename) (change--1 ,revision)))
+
+(el-search-defpattern changed--1 (&optional revision)
   (declare (heuristic-matcher #'el-search-change--heuristic-matcher))
-  `(guard (el-search--change-p (point) ,(or revision "HEAD"
+  `(guard (el-search--changed-p (point) ,(or revision "HEAD"
 
 (el-search-defpattern changed (&optional revision)
   "Matches the object if its text contains a file change.
@@ -392,8 +403,7 @@ REVISION is interpreted.
 
 This pattern-type does curr

[elpa] scratch/mheerdegen-preview c8d9698 26/35: WIP: [el-search] Some minor tweaks

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit c8d96984046c3651cf93031007245f1e82af4755
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: [el-search] Some minor tweaks

Add one newline.
>el-search-use-prefix-transient-map, el-search-use-prefix-key-transient-map.
---
 packages/el-search/el-search-x.el |  6 ++--
 packages/el-search/el-search.el   | 73 ---
 2 files changed, 56 insertions(+), 23 deletions(-)

diff --git a/packages/el-search/el-search-x.el 
b/packages/el-search/el-search-x.el
index 1a40322..5b84cb9 100644
--- a/packages/el-search/el-search-x.el
+++ b/packages/el-search/el-search-x.el
@@ -247,8 +247,10 @@ COMMIT defaults to HEAD."
   (let ((default-directory repo-root-dir))
 (mapcar #'expand-file-name
 (split-string
- (shell-command-to-string
-  (format "git diff -z --name-only %s --" (shell-quote-argument 
commit)))
+ (let ((current-message (current-message)))
+   (with-temp-message (concat current-message "  [Running Git...]")
+ (shell-command-to-string
+  (format "git diff -z --name-only %s --" 
(shell-quote-argument commit)
  "\0" t
 
 (defvar vc-git-diff-switches)
diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 7c964ca..28bc152 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -425,6 +425,13 @@
 ;;
 ;; TODO:
 ;;
+;; - Add org and/or Info documentation
+;;
+;; - Make currently hardcoded bindings in
+;;   `el-search-loop-over-bindings' configurable
+;;
+;; - Add menus?
+;;
 ;; - Make searching work in comments, too? (->
 ;;   `parse-sexp-ignore-comments').  Related: should the pattern
 ;;   `symbol' also match strings that contain matches for a symbol so
@@ -584,7 +591,7 @@ from the prompt."
  (const :tag "On"  t)
  (const :tag "Ask" ask)))
 
-(defvar el-search-use-transient-map nil
+(defvar el-search-use-prefix-key-transient-map nil
   "Whether el-search should make commands repeatable."
   ;; I originally wanted to make commands repeatable by looking at the
   ;; command keys.  But that got overly complicated: It interfered with
@@ -612,7 +619,7 @@ from the prompt."
 digit-argument negative-argument)
   "List of commands that don't end repeatability of el-search commands.
 
-When `el-search-use-transient-map' is non-nil, when any
+When `el-search-use-prefix-key-transient-map' is non-nil, when any
 \"repeatable\" el-search command had been invoked, executing any
 of these commands will keep the
 `el-search-prefix-key-transient-map' further in effect.")
@@ -788,6 +795,22 @@ nil."
 (`(,(pred (equal args)) . ,result) result)
 (_ (cdr (setq cached (cons args (apply function args)
 
+;; (defun el-search-with-long-term-memory (function &optional predicate)
+;;   "Wrap FUNCTION to cache all calls.
+;; With PREDICATE given, only cache calls where the arguments
+;; fulfill PREDICATE.  In this case, the last call is always
+;; remembered as in `el-search-with-short-term-memory'."
+;;   (let ((cached (make-hash-table :test #'equal)))
+;; (el-search-with-short-term-memory
+;;  (lambda (&rest args)
+;;(if-let ((cache-entry (gethash args cached)))
+;;(cdr cache-entry)
+;;  (let ((result (apply function args)))
+;;(when (or (not predicate)
+;;  (apply predicate args))
+;;  (puthash args (cons t result) cached))
+;;result))
+
 (defmacro el-search-when-unwind (body-form &rest unwindforms)
   "Like `unwind-protect' but eval the UNWINDFORMS only if unwinding."
   (declare (indent 1))
@@ -1729,13 +1752,12 @@ PATTERN and combining the heuristic matchers of the 
subpatterns."
   (setq buffer (or (find-buffer-visiting next)
(let ((warning-minimum-level :error)
  (inhibit-message t))
- (let ((fresh-buffer (generate-new-buffer " 
el-search-helper-buffer"))
-   (inhibit-message t))
+ (let ((fresh-buffer (generate-new-buffer " 
el-search-helper-buffer")))
(with-current-buffer fresh-buffer
  (insert-file-contents next)
  (emacs-lisp-mode)
  (setq-local el-search--temp-file-buffer-flag 
next)
- (setq-local buffer-file-name next) ;make 
`file' pattern work as expected
+ (setq-local buffer-file-name next) ;make 
`file' pat work as expected
  (set-visited-file-modtime)
  (set-buffer-modified-p nil))
fresh-buffer)
@@ -2036,7 +2058,7 @@ The following bindings are available only when a search

[elpa] scratch/mheerdegen-preview 237c2c6 33/35: WIP: [el-search] Enhance doc of el-search-occur-mode

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 237c2c637916473386d1a2afb0a25cf5cd6d3689
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: [el-search] Enhance doc of el-search-occur-mode
---
 packages/el-search/el-search.el | 15 ++-
 1 file changed, 14 insertions(+), 1 deletion(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 8739425..799446b 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -3481,7 +3481,7 @@ Prompt for a new pattern and revert."
#'hs-toggle-hiding
  #'outline-toggle-children)))
 
-(defvar el-search-occur-mode-map
+(defvar el-search-occur-mode-map-1
   (let ((map (make-sparse-keymap)))
 (define-key map [tab]   #'el-search-occur-tab-command)
 (define-key map "\t"#'el-search-occur-tab-command)
@@ -3498,10 +3498,23 @@ Prompt for a new pattern and revert."
 (define-key map [?c ?d] #'el-search-occur-defun-context)
 (define-key map [?c ?a] #'el-search-occur-defun-context)
 (define-key map [?c ?s] #'el-search-occur-some-context)
+map))
+
+(defvar el-search-occur-mode-map
+  (let ((map (copy-keymap el-search-occur-mode-map-1)))
 (set-keymap-parent map (make-composed-keymap special-mode-map 
emacs-lisp-mode-map))
 map))
 
 (define-derived-mode el-search-occur-mode emacs-lisp-mode "El-Occur"
+  "Major mode for El-Occur buffers.
+
+This mode provides the following key bindings:
+
+\\{el-search-occur-mode-map-1}
+The mode's keymap inherits from `emacs-lisp-mode-map' and in
+addition from `special-mode-map':
+
+\\{special-mode-map}"
   (setq-local revert-buffer-function #'el-search-occur-revert-function)
   (setq buffer-read-only t)
   (setq-local hs-hide-comments-when-hiding-all nil)

[elpa] scratch/mheerdegen-preview f025458 12/35: WIP [el-search] Add quick help command

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit f0254582963e0cd7282c3236353a1f2c792bfef8
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP [el-search] Add quick help command
---
 packages/el-search/el-search.el | 46 ++---
 1 file changed, 43 insertions(+), 3 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 90b8d04..9e55b9a 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -43,6 +43,11 @@
 ;; later.  Finally, it allows you to define your own kinds of search
 ;; patterns and your own multi-search commands.
 ;;
+;; The following text is an exhaustive introduction to this package.
+;; After having learned the basics, hitting C-? or ?
+;; (el-search-toggle-quick-help) should suffice to refresh your
+;; memory.
+;;
 ;;
 ;; Key bindings
 ;; 
@@ -83,6 +88,11 @@
 ;; hit RET to exit, or hit C-g to abort and jump back to where you
 ;; started.
 ;;
+;;   C-?, M-s e ? (el-search-toggle-quick-help)
+;;
+;; While an el-search is active, popup (or close) quick help
+;; window.
+;;
 ;;   C-R, M-s e r (el-search-pattern-backward)
 ;; Search backward.
 ;;
@@ -415,8 +425,6 @@
 ;;
 ;; TODO:
 ;;
-;; - Add a help command that can be called while searching.
-;;
 ;; - Make searching work in comments, too? (->
 ;;   `parse-sexp-ignore-comments').  Related: should the pattern
 ;;   `symbol' also match strings that contain matches for a symbol so
@@ -579,6 +587,7 @@ from the prompt."
   ;; explicitly install the transient map themselves.
   '(el-search-pattern
 el-search-pattern-backward
+el-search-toggle-quick-help
 el-search-from-beginning
 el-search-last-buffer-match
 el-search-continue-in-next-buffer
@@ -1180,6 +1189,15 @@ be specified as fourth argument, and COUNT becomes the 
fifth argument."
   (funcall fail)
 match-beg)))
 
+(defvar el-search-quick-help-buffer-name "*El-search help*" )
+(defvar el-search-quick-help "...More doc to come here...")
+
+(defun el-search-close-quick-help-maybe ()
+  (when-let ((help-buffer (get-buffer el-search-quick-help-buffer-name))
+ (help-wins (get-buffer-window-list help-buffer)))
+(mapc #'delete-window help-wins)
+t))
+
 (defun el-search-forward (pattern &optional bound noerror count)
   "Search for el-search PATTERN in current buffer from point.
 Set point to the beginning of the occurrence found and return point.
@@ -1733,6 +1751,7 @@ in, in order, when called with no arguments."
 
 ;;;###autoload
 (defun el-search-loop-over-bindings (function)
+  (defvar el-search-basic-transient-map) ;defined later
   (cl-flet ((keybind (apply-partially #'funcall function)))
 
 (keybind emacs-lisp-mode-map   ?s #'el-search-pattern)
@@ -1797,6 +1816,9 @@ any case."
 (define-key transient-map [return]   #'el-search-pause-search)
 (define-key transient-map (kbd "RET")#'el-search-pause-search)
 (define-key transient-map [(control ?g)] #'el-search-keyboard-quit)
+(define-key transient-map `[,help-char]  #'el-search-toggle-quick-help)
+(define-key transient-map [help] #'el-search-toggle-quick-help)
+(define-key transient-map [f1]   #'el-search-toggle-quick-help)
 transient-map))
 
 (defvar el-search-prefix-key-transient-map
@@ -1823,6 +1845,23 @@ any case."
 (set-keymap-parent transient-map el-search-basic-transient-map)
 transient-map))
 
+(defun el-search-toggle-quick-help ()
+  "Doc..."
+  (interactive)
+  (setq this-command 'el-search-pattern)
+  (unless (el-search-close-quick-help-maybe)
+(with-current-buffer (get-buffer-create el-search-quick-help-buffer-name)
+  (erase-buffer)
+  (insert el-search-quick-help)
+  (when el-search-use-prefix-key-transient-map
+(insert (substitute-command-keys
+ "
+
+The following bindings are available only when a search is active:
+\\{el-search-prefix-key-transient-map}")))
+  (goto-char (point-min))
+  (display-buffer (current-buffer)
+
 (defun el-search-keep-session-command-p (command)
   "Non-nil when COMMAND should not deactivate the current search."
   (and
@@ -2439,7 +2478,8 @@ local binding of `window-scroll-functions'."
  (el-search-hl-remove)
  (remove-hook 'post-command-hook 'el-search-hl-post-command-fun t)
  (setq el-search--temp-buffer-flag nil)
- (el-search-kill-left-over-search-buffers)
+ (el-search-kill-left-over-search-buffers)
+ (el-search-close-quick-help-maybe)
 
 (defun el-search--pending-search-p ()
   (memq #'el-search-hl-post-command-fun post-command-hook))

[elpa] scratch/mheerdegen-preview 38def8b 25/35: WIP: Test: Make mouse clicks not abort the search

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 38def8b469501e2c62291a0604c350981349384e
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Test: Make mouse clicks not abort the search
---
 packages/el-search/el-search.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index b86a775..7c964ca 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -2031,7 +2031,8 @@ The following bindings are available only when a search 
is active:
el-search-allow-scroll
(symbolp command)
(or (get command 'isearch-scroll) ;isearch is preloaded
-   (get command 'scroll-command
+   (get command 'scroll-command)
+   (memq command '(mouse-set-point mouse-drag-region mouse-set-region)
 
 (defun el-search-prefix-key-maybe-set-transient-map ()
   (set-transient-map

[elpa] scratch/mheerdegen-preview 99782c3 19/35: WIP [el-search] Fix search setup when occur flag bound

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 99782c39e947ef1a628b458fe27dcba1eac92517
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP [el-search] Fix search setup when occur flag bound
---
 packages/el-search/el-search.el | 8 +---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index bd979c7..5d2463e 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -2037,14 +2037,16 @@ The following bindings are available only when a search 
is active:
   (setq el-search-use-transient-map t))
 
 (defun el-search-setup-search-1 (pattern get-buffer-stream  &optional 
from-here setup-function)
-  (el-search--set-search-origin-maybe)
-  (setq el-search--success nil)
+  (unless el-search-occur-flag
+(el-search--set-search-origin-maybe)
+(setq el-search--success nil))
   (setq el-search--current-search
 (el-search-make-search pattern get-buffer-stream))
   (when setup-function (funcall setup-function el-search--current-search))
   (ring-insert el-search-history el-search--current-search)
   (when from-here (setq el-search--temp-buffer-flag nil))
-  (el-search-prefix-key-maybe-set-transient-map))
+  (unless el-search-occur-flag
+(el-search-prefix-key-maybe-set-transient-map)))
 
 (defun el-search-setup-search (pattern get-buffer-stream &optional 
setup-function from-here)
   "Create and start a new el-search.

[elpa] scratch/mheerdegen-preview 6ed849a 34/35: WIP: [el-search] Don't kill modified buffers

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 6ed849aaacee61bfaab72131899eae70f4d7b33e
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: [el-search] Don't kill modified buffers

This fixes a problem introduced in 1d2bbf66 "Improve working of
`el-search-kill-left-over-search-buffers'": We still need to check
whether the buffer to be killed has been modified (by
'el-search-query-replace').

(el-search-kill-left-over-search-buffers): Exclude modified buffers
from killing.
---
 packages/el-search/el-search.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 799446b..e556cd9 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -1531,7 +1531,8 @@ the cursor) are not killed."
   (interactive)
   (dolist (buffer (buffer-list))
 (when (with-current-buffer buffer el-search--temp-buffer-flag)
-  (unless (or (el-search--search-buffer-p buffer)
+  (unless (or (buffer-modified-p buffer) ; modified with 
el-s-query-replace and auto-save off
+  (el-search--search-buffer-p buffer)
   (with-current-buffer buffer (el-search--pending-search-p)))
 (kill-buffer buffer)
 

[elpa] scratch/mheerdegen-preview 82abecf 16/35: WIP: Additions to "Mb hints"

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 82abecf128e0f449ab1f5a46b7fbf322cb52d55e
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Additions to "Mb hints"
---
 packages/el-search/el-search.el | 50 +
 1 file changed, 36 insertions(+), 14 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 117da55..79de021 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -799,11 +799,17 @@ nil."
  (unless ,done
,@unwindforms)
 
+(defvar el-search--last-message nil)
+
 (defun el-search--message-no-log (format-string &rest args)
   "Like `message' but with `message-log-max' bound to nil."
   (let ((message-log-max nil))
 (apply #'message format-string args)))
 
+(defun el-search--set-this-command-refresh-message-maybe ()
+  (when (eq (setq this-command 'el-search-pattern) last-command)
+(message "%s" el-search--last-message)))
+
 (defalias 'el-search-read
   (if (boundp 'force-new-style-backquotes)
   (lambda (&optional stream)
@@ -910,8 +916,11 @@ nil."
 (timer-set-time el-search--mb-hints-timer (time-add (current-time) 
el-search-mb-hints-delay))
 (timer-activate el-search--mb-hints-timer)))
 
+(defvar el-search--this-session-match-count-data nil)
+
 (defun el-search-read-pattern-setup-mb-hints ()
   (when el-search-display-mb-hints
+(setq el-search--this-session-match-count-data nil)
 (when (timerp el-search--mb-hints-timer) (cancel-timer 
el-search--mb-hints-timer))
 (setq el-search--mb-hints-timer nil)
 (add-hook 'post-command-hook #'el-search-read-pattern-trigger-mb-hints t 
t)))
@@ -2486,12 +2495,21 @@ created.")
   (when (or just-count (and el-search--success (not el-search--wrap-flag)))
 (prog1
 (while-no-input
-  (apply (if just-count #'format #'el-search--message-no-log)
+  (apply (if just-count #'format
+   (lambda (&rest args)
+ (setq el-search--last-message (apply 
#'el-search--message-no-log args
  (progn
 
;; Check whether cached stream of buffer matches is still 
valid
(pcase el-search--buffer-match-count-data
- (`(,(pred (eq el-search--current-search))  ,(pred (eq 
(buffer-chars-modified-tick)))  . ,_))
+ ((or
+   (and `(,(and (pred el-search-object-p)
+(pred (eq el-search--current-search)))
+  . ,_)
+(pred (eq 
el-search--this-session-match-count-data)))
+   `(,(pred (eq el-search--current-search))
+ ,(pred (eq (buffer-chars-modified-tick)))  . ,_)))
+
  (_
   ;; (message "Refreshing match count data") (sit-for 1)
   (redisplay) ;don't delay highlighting
@@ -2506,7 +2524,9 @@ created.")
 (list
  el-search--current-search
  (buffer-chars-modified-tick)
- stream-of-buffer-matches)
+ stream-of-buffer-matches)))
+  (setq el-search--this-session-match-count-data
+el-search--buffer-match-count-data)))
 
(let ((pos-here (point)) (matches-<=-here 1) total-matches
  (defun-bounds (or (el-search--bounds-of-defun) (cons 
(point) (point
@@ -2609,7 +2629,8 @@ local binding of `window-scroll-functions'."
 (remove-hook 'post-command-hook 
'el-search-hl-post-command-fun t)
 (setq el-search--temp-buffer-flag nil)
 (el-search-kill-left-over-search-buffers)
-(el-search-close-quick-help-maybe
+(el-search-close-quick-help-maybe)
+(setq el-search--this-session-match-count-data nil
 (pcase this-command
   ((guard stop) (stop))
   ('el-search-query-replace)
@@ -2622,12 +2643,13 @@ local binding of `window-scroll-functions'."
   (el-search--make-display-animation-function
(lambda (icon)
  (let ((inhibit-message nil))
-   (el-search--message-no-log
-"%s   %s"
-(let ((head (el-search-object-head 
el-search--current-search)))
-  (or (el-search-head-file head)
-  (el-search-head-buffer head)))
-icon
+   (setq el-search--last-message
+ (el-search--message-no-log
+  "%s   %s"
+  (let ((head (el-search

[elpa] scratch/mheerdegen-preview 91f5bd3 18/35: WIP [el-search] Fix C-j with numeric arg in error case

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 91f5bd3dddb3c99a57b4632a21787b269cfe59b8
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP [el-search] Fix C-j with numeric arg in error case
---
 packages/el-search/el-search.el | 76 ++---
 1 file changed, 41 insertions(+), 35 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index d9791d0..bd979c7 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -2762,41 +2762,47 @@ make current."
 (el-search-continue-search))
 (setq this-command 'el-search-pattern)
 (pop-to-buffer current-search-buffer 
el-search-display-buffer-popup-action)
-(let ((last-match (el-search-object-last-match search)))
-  (cond
-   ((< (prefix-numeric-value arg) 0)
-(progn (setq arg (prefix-numeric-value arg))
-   (goto-char (window-end
-   ((not (numberp arg))
-(goto-char (if (not (and last-match
- ;; this should only happen for bad search 
patterns
- (eq (marker-buffer last-match) 
(current-buffer
-   (el-search-head-position current-head)
- last-match)))
-   ((zerop arg) (setq arg 1))
-   (t (goto-char (window-start
-  (let ((match-pos
- (save-excursion
-   (el-search--search-pattern-1
-(el-search--current-matcher)
-(not (numberp arg)) nil ;FIXME: Handle no match case 
explicitly
-(el-search--current-heuristic-matcher)
-(if (numberp arg) arg 1)
-(unless (or (numberp arg) (eq (point) match-pos))
-  (message "No match at search head any more - going to the next 
match")
-  (redisplay)
-  ;; Don't just `sit-for' here: `pop-to-buffer' may have generated 
frame
-  ;; focus events
-  (sleep-for 1.5))
-(if (not match-pos)
-(el-search-continue-search)
-  (goto-char match-pos)
-  (setf (el-search-head-position current-head)
-(copy-marker (point)))
-  (setf (el-search-object-last-match el-search--current-search)
-(copy-marker (point)))
-  (el-search-hl-sexp)
-  (el-search-hl-other-matches (el-search--current-matcher))
+(el-search-protect-search-head
+ (let ((last-match (el-search-object-last-match search)))
+   (cond
+((< (prefix-numeric-value arg) 0)
+ (progn (setq arg (prefix-numeric-value arg))
+(goto-char (window-end
+((not (numberp arg))
+ (goto-char (if (not (and last-match
+  ;; this should only happen for bad 
search patterns
+  (eq (marker-buffer last-match) 
(current-buffer
+(el-search-head-position current-head)
+  last-match)))
+((zerop arg) (setq arg 1))
+(t (goto-char (window-start
+   (let ((match-pos
+  (save-excursion
+(el-search--search-pattern-1
+ (el-search--current-matcher)
+ t nil
+ (el-search--current-heuristic-matcher)
+ (if (numberp arg) arg 1)
+ (when (and (numberp arg) (not match-pos))
+   (setq el-search--success nil)
+   (el-search-hl-post-command-fun 'stop)
+   (goto-char el-search--search-origin)
+   (user-error "No match there"))
+ (unless (or (numberp arg) (eq (point) match-pos))
+   (message "No match at search head any more - going to the next 
match")
+   (redisplay)
+   ;; Don't just `sit-for' here: `pop-to-buffer' may have 
generated frame
+   ;; focus events
+   (sleep-for 1.5))
+ (if (not match-pos)
+ (el-search-continue-search)
+   (goto-char match-pos)
+   (setf (el-search-head-position current-head)
+ (copy-marker (point)))
+   (setf (el-search-object-last-match el-search--current-search)
+ (copy-marker (point)))
+   (el-search-hl-sexp)
+   (el-search-hl-other-matches (el-search--current-matcher)))
 (el-search--message-no-log "[Search completed - restarting]")
 (sit-for 1.5)
 (el-search-reset-search el-search--current-search)

[elpa] scratch/mheerdegen-preview b4b94b0 11/35: WIP [el-search] Implement 'el-search-keyboard-quit'

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit b4b94b0dd124cc3c59735197c48d7db8ce976744
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP [el-search] Implement 'el-search-keyboard-quit'
---
 packages/el-search/el-search.el | 38 +-
 1 file changed, 29 insertions(+), 9 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index dd1ddf7..90b8d04 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -80,7 +80,8 @@
 ;; minibuffer).  All commands that are not search or scrolling
 ;; commands terminate the search, while the state of the search is
 ;; always automatically saved.  Like in isearch you can also just
-;; hit RET to exit.
+;; hit RET to exit, or hit C-g to abort and jump back to where you
+;; started.
 ;;
 ;;   C-R, M-s e r (el-search-pattern-backward)
 ;; Search backward.
@@ -414,10 +415,6 @@
 ;;
 ;; TODO:
 ;;
-;; - There should be a way to go back to the starting position, like
-;;   in Isearch, which does this with (push-mark isearch-opoint t) in
-;;   `isearch-done'.
-;;
 ;; - Add a help command that can be called while searching.
 ;;
 ;; - Make searching work in comments, too? (->
@@ -677,6 +674,9 @@ useful for debugging.")
 (defvar el-search--current-search nil
   "The currently active search, an `el-search-object', or nil.")
 
+(defvar el-search--search-origin nil
+  "Doc...")
+
 (defvar-local el-search--temp-buffer-flag nil
   "Non-nil tags file visiting buffers as temporarily opened for searching.")
 
@@ -1779,10 +1779,24 @@ any case."
   (interactive)
   nil)
 
+(defun el-search--set-search-origin-maybe ()
+  (unless (el-search--pending-search-p)
+(setq el-search--search-origin (copy-marker (point)
+
+(defun el-search-keyboard-quit (&optional dont-quit)
+  (interactive)
+  (setq el-search--success nil)
+  (el-search-hl-post-command-fun) ;clear highlighting
+  (switch-to-buffer (marker-buffer el-search--search-origin))
+  (goto-char el-search--search-origin)
+  (unless dont-quit
+(signal 'quit nil)))
+
 (defvar el-search-basic-transient-map
   (let ((transient-map (make-sparse-keymap)))
-(define-key transient-map [return]#'el-search-pause-search)
-(define-key transient-map (kbd "RET") #'el-search-pause-search)
+(define-key transient-map [return]   #'el-search-pause-search)
+(define-key transient-map (kbd "RET")#'el-search-pause-search)
+(define-key transient-map [(control ?g)] #'el-search-keyboard-quit)
 transient-map))
 
 (defvar el-search-prefix-key-transient-map
@@ -1847,6 +1861,7 @@ any case."
   (setq el-search-use-transient-map t))
 
 (defun el-search-setup-search-1 (pattern get-buffer-stream  &optional 
from-here setup-function)
+  (el-search--set-search-origin-maybe)
   (setq el-search--success nil)
   (setq el-search--current-search
 (el-search-make-search pattern get-buffer-stream))
@@ -2380,7 +2395,8 @@ created.")
  (concat "[Not at a match]   "
  (if (= matches-<=-here total-matches)
  (format "(%s/%s <-)" matches-<=-here 
total-matches)
-   (format "(-> %s/%s)" (1+ matches-<=-here) 
total-matches
+   (format "(-> %s/%s)" (1+ matches-<=-here) 
total-matches))
+(when quit-flag (el-search-keyboard-quit 'dont-quit
 
 (defun el-search-hl-other-matches (matcher)
   "Highlight all visible matches.
@@ -2463,6 +2479,7 @@ In a non-interactive call, ARG should be an integer, 
having the
 same meaning as a numeric prefix arg, or an el-search-object to
 make current."
   (interactive "P")
+  (el-search--set-search-origin-maybe)
   (when (integerp arg)
 (el-search-barf-if-not-search-buffer
  (current-buffer)
@@ -2569,6 +2586,8 @@ instead of the position where the search would normally be
 continued."
   (interactive "P")
   (setq this-command 'el-search-pattern)
+  (unless (eq last-command this-command)
+(el-search--set-search-origin-maybe))
   (el-search-compile-pattern-in-search el-search--current-search)
   (el-search-protect-search-head
(unwind-protect
@@ -2739,6 +2758,7 @@ executed, and nil else."
 With prefix ARG, restart the current search when positive; go to the
 last match in the current buffer when negative."
   (interactive "P")
+  (el-search--set-search-origin-maybe)
   (cond
((< (prefix-numeric-value arg) 0)
 (el-search-last-buffer-match))
@@ -2756,7 +2776,7 @@ last match in the current buffer when negative."
 (defun el-search-last-buffer-match ()
   "Go to the last of this buffer's matches."
   (interactive)
-  (setq this-command 'el-search-pattern)
+  (el-search--set-search-origin-maybe)
   (el-search-barf-if-not-search-buffer)
   (el-search--unless-no-buffer-match
 (goto-char (point-max))

[elpa] scratch/mheerdegen-preview 220f349 04/35: WIP: Add package "sscell"

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 220f3494732e1a8cfe2d363dafa414c35fa1034f
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Add package "sscell"
---
 packages/sscell/sscell-tests.el | 120 +++
 packages/sscell/sscell.el   | 208 
 2 files changed, 328 insertions(+)

diff --git a/packages/sscell/sscell-tests.el b/packages/sscell/sscell-tests.el
new file mode 100644
index 000..7837e33
--- /dev/null
+++ b/packages/sscell/sscell-tests.el
@@ -0,0 +1,120 @@
+;;; sscell-tests --- Regression tests for sscell.el   -*- lexical-binding: t 
-*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Michael Heerdegen 
+;; Maintainer: Michael Heerdegen 
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see .
+
+
+(require 'ert)
+(require 'cl-lib)
+(require 'sscell)
+(eval-when-compile (require 'subr-x))
+
+
+;; Tests analogue to thunk-tests.el
+
+(ert-deftest sscell-is-lazy-and-can-be-evaluated ()
+  (let* (x  (sscell (sscell-make () (ignore (setq x t)
+(should (null x))
+(ignore (sscell-get sscell))
+(should x)))
+
+(ert-deftest sscell-evaluation-is-cached ()
+  (let* ((x 0)
+ (sscell (sscell-make () (setq x (1+ x)
+(ignore (sscell-get sscell))
+(should (= x 1))
+(ignore (sscell-get sscell))
+(should (= x 1
+
+(ert-deftest sscell-let-basic-test ()
+  "Test whether bindings are established."
+  (should (equal (sscell-let ((x () 1) (y () 2)) (+ x y)) 3)))
+
+(ert-deftest sscell-let*-basic-test ()
+  "Test whether bindings are established."
+  (should (equal (sscell-let* ((x () 1) (y () (+ 1 x))) (+ x y)) 3)))
+
+(ert-deftest sscell-let-bound-vars-can-be-set-test ()
+  ;; Contrary to thunks this works...
+  "Test whether setting a `sscell-let' bound variable works."
+  (should
+   (eq 80 (sscell-let ((x () 1))
+(let ((y 7))
+  (setq x (+ x y))
+  (* 10 x))
+
+(ert-deftest sscell-let-laziness-test ()
+  "Test laziness of `sscell-let'."
+  (should
+   (equal (let ((x-evalled nil)
+(y-evalled nil))
+(sscell-let ((x () (progn (setq x-evalled t) (+ 1 2)))
+ (y () (progn (setq y-evalled t) (+ 3 4
+  (let ((evalled-y y))
+(list x-evalled y-evalled evalled-y
+  (list nil t 7
+
+(ert-deftest sscell-let*-laziness-test ()
+  "Test laziness of `sscell-let*'."
+  (should
+   (equal (let ((x-evalled nil)
+(y-evalled nil)
+(z-evalled nil)
+(a-evalled nil))
+(sscell-let* ((x () (progn (setq x-evalled t) (+ 1 1)))
+  (y () (progn (setq y-evalled t) (+ x 1)))
+  (z () (progn (setq z-evalled t) (+ y 1)))
+  (a () (progn (setq a-evalled t) (+ z 1
+  (let ((evalled-z z))
+(list x-evalled y-evalled z-evalled a-evalled evalled-z
+  (list t t t nil 4
+
+(ert-deftest sscell-let-bad-binding-test ()
+  "Test whether a bad binding causes an error when expanding."
+  (should-error (macroexpand '(sscell-let ((x () 1 1)) x)))
+  (should-error (macroexpand '(sscell-let (27) x)))
+  (should-error (macroexpand '(sscell-let x x
+
+
+;; Tests for implicit dependencies
+
+(ert-deftest sscell-implicit-dep-test-1 ()
+  (let ((a (sscell-make () 10))
+(b (sscell-make () 20))
+(c (sscell-make () 40)))
+(let* ((cell1 (sscell-make () (+ (sscell-get a) (sscell-get b
+   (cell2 (sscell-make ()
+(let ((counter 0))
+  (while (< (sscell-get cell1) (sscell-get c))
+(cl-incf counter)
+(cl-incf (sscell-get a)))
+  counter
+  (should (eq (sscell-get cell2) 10)
+
+(ert-deftest sscell-implicit-dep-test-2 ()
+  (let ((cells (cl-loop for i from 1 to 10 collect (sscell-make () nil
+(sscell-set-value (nth 0 cells) 1)
+(cl-maplist (lambda (rest) (when (cdr rest) (sscell-set (cadr rest) () (1+ 
(sscell-get (car rest))
+cells)
+(should (eq (sscell-get (car (last cells))) 10
+
+
+(provide 'sscell-tests)
+;;; sscell-tests.el ends here
diff --git a/packages/sscell/sscell.el b/packages/sscell/sscell.el
new file

[elpa] scratch/mheerdegen-preview bef717d 06/35: WIP: New :key arg for "filename" and new pattern types "file" and "dir"

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit bef717d4538f3c167149587ae57c5808674dcf98
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: New :key arg for "filename" and new pattern types "file" and "dir"
---
 packages/el-search/el-search.el | 81 +++--
 1 file changed, 61 insertions(+), 20 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index db5117d..28ab546 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -2089,42 +2089,83 @@ is matched by the `el-search-regexp-like-p' REGEXP."
   ',regexp)
   ,this)
 
-(defun el-search--filename-matcher (&rest regexps)
+(defun el-search--filename-matcher (fun &rest regexps)
   ;; Return a file name matcher for the REGEXPS.  This is a predicate
   ;; accepting two arguments that returns non-nil when the first
   ;; argument is a file name (i.e. a string) that is matched by all
   ;; `el-search-regexp-like-p' REGEXPS, or a buffer whose associated file
   ;; name matches accordingly.  It ignores the second argument.
-  (let ((get-file-name (lambda (file-name-or-buffer)
- (if (bufferp file-name-or-buffer)
- (buffer-file-name file-name-or-buffer)
-   file-name-or-buffer
-(if (not regexps)
-(lambda (file-name-or-buffer _) (funcall get-file-name 
file-name-or-buffer))
-  (let* ((regexp-matchers (mapcar #'el-search--string-matcher regexps))
- (test-file-name-or-buffer
-  (el-search-with-short-term-memory
-   (lambda (file-name-or-buffer)
- (when-let ((file-name (funcall get-file-name 
file-name-or-buffer)))
-   (cl-every (lambda (matcher) (funcall matcher file-name)) 
regexp-matchers))
-(lambda (file-name-or-buffer _) (funcall test-file-name-or-buffer 
file-name-or-buffer))
+  (let (real-fun)
+(pcase regexps
+  (`(:key ,specified-fun . ,more-regexps)
+   (setq real-fun (lambda (arg) (funcall specified-fun (funcall fun 
arg)))
+ regexps  more-regexps))
+  (_ (setq real-fun fun)))
+(let ((get-file-name (lambda (file-name-or-buffer)
+   (funcall real-fun
+(if (bufferp file-name-or-buffer)
+(buffer-file-name file-name-or-buffer)
+  file-name-or-buffer)
+  (if (not regexps)
+  (lambda (file-name-or-buffer _) (funcall get-file-name 
file-name-or-buffer))
+(let* ((regexp-matchers (mapcar #'el-search--string-matcher regexps))
+   (test-file-name-or-buffer
+(el-search-with-short-term-memory
+ (lambda (file-name-or-buffer)
+   (when-let ((file-name (funcall get-file-name 
file-name-or-buffer)))
+ (cl-every (lambda (matcher) (funcall matcher file-name)) 
regexp-matchers))
+  (lambda (file-name-or-buffer _) (funcall test-file-name-or-buffer 
file-name-or-buffer)))
 
 (el-search-defpattern filename (&rest regexps)
   "Matches anything when the searched buffer has an associated file.
 
 With any `el-search-regexp-like-p' REGEXPS given, the file's
-absolute name must be matched by all of them."
-  ;;FIXME: should we also allow to match the f-n-nondirectory and
-  ;;f-n-sans-extension?  Maybe it could become a new pattern type named 
`feature'?
-  (declare (heuristic-matcher #'el-search--filename-matcher)
+absolute name must be matched by all of them.
+
+The list of REGEXPS can optionally be prefixed with two elements :key
+KEYFUN.  Then the filename will be passed to KEYFUN before matching.
+
+Example: This will match any pattern in any file whose name without
+extension matches \"el\":
+
+  (filename :key file-name-sans-extension \"el\").
+
+See also the pattern types \"file\" and \"dir\" that use a key
+function implicitly (but support to specify a :key nonetheless)."
+  (declare (heuristic-matcher (apply-partially #'el-search--filename-matcher 
#'identity))
(inverse-heuristic-matcher t))
-  (el-search-defpattern--check-args "filename" regexps 
#'el-search-regexp-like-p)
-  (let ((file-name-matcher (apply #'el-search--filename-matcher regexps)))
+  (el-search-defpattern--check-args "filename"
+(if (eq (car-safe regexps) :key) (cddr 
regexps) regexps)
+#'el-search-regexp-like-p)
+  (let ((file-name-matcher (apply #'el-search--filename-matcher #'identity 
regexps)))
 ;; We can't expand to just t because this would not work with `not'.
 ;; `el-search--filename-matcher' caches the result, so this is still a
 ;; pseudo constant
 `(guard (funcall ',file-name-matcher (current-buffer) nil
 
+(defun el-search--file-director

[elpa] scratch/mheerdegen-preview 5e2aea1 20/35: WIP [el-search] Adjust prev/next match commands for search and occur

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 5e2aea11fda4d08b3aefc0385ba211c46a8d31f0
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP [el-search] Adjust prev/next match commands for search and occur
---
 packages/el-search/el-search.el | 10 +++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 5d2463e..4e403b3 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -116,7 +116,7 @@
 ;;   C-O or M-RET (from a search pattern prompt)
 ;; Execute this search command as occur.
 ;;
-;;   C-N, M-s e n (el-search-continue-in-next-buffer)
+;;   C-X, M-s e x (el-search-continue-in-next-buffer)
 ;; Skip over current buffer or file.
 ;;
 ;;   C-D, M-s e d (el-search-skip-directory)
@@ -251,7 +251,7 @@
 ;; `el-search-jump-to-search-head' (C-J; M-s e j): this command jumps
 ;; to the last match and re-activates the search.
 ;;
-;; `el-search-continue-in-next-buffer' (C-N; n) skips all remaining
+;; `el-search-continue-in-next-buffer' (C-X; x) skips all remaining
 ;; matches in the current buffer and continues searching in the next
 ;; buffer.  `el-search-skip-directory' (C-D; d) even skips all
 ;; subsequent files under a specified directory.
@@ -1893,6 +1893,8 @@ in, in order, when called with no arguments."
 
 (keybind emacs-lisp-mode-map   ?s #'el-search-pattern)
 (keybind emacs-lisp-mode-map   ?r #'el-search-pattern-backward)
+(keybind emacs-lisp-mode-map   ?n #'el-search-pattern)
+(keybind emacs-lisp-mode-map   ?p #'el-search-pattern-backward)
 (keybind emacs-lisp-mode-map   ?% #'el-search-query-replace)
 (keybind emacs-lisp-mode-map   ?t #'el-search-this-sexp)
 (keybind global-map?j #'el-search-jump-to-search-head)
@@ -1900,7 +1902,7 @@ in, in order, when called with no arguments."
 (keybind global-map?< #'el-search-from-beginning)
 (keybind emacs-lisp-mode-map   ?> #'el-search-last-buffer-match)
 (keybind global-map?d #'el-search-skip-directory)
-(keybind global-map?n 
#'el-search-continue-in-next-buffer)
+(keybind global-map?x 
#'el-search-continue-in-next-buffer)
 
 (keybind global-map?o #'el-search-occur)
 (keybind emacs-lisp-mode-map   ?h #'el-search-highlight-pattern)
@@ -3414,6 +3416,8 @@ Prompt for a new pattern and revert."
 (define-key map [(shift tab)]   #'el-search-occur-cycle)
 (define-key map [?p]#'el-search-occur-previous-match)
 (define-key map [?n]#'el-search-occur-next-match)
+(define-key map [?r]#'el-search-occur-previous-match)
+(define-key map [?s]#'el-search-occur-next-match)
 (define-key map [?e]#'el-search-edit-occur-pattern)
 (define-key map [?c ?n] #'el-search-occur-no-context)
 (define-key map [?c ?d] #'el-search-occur-defun-context)

[elpa] scratch/mheerdegen-preview b43f7bb 07/35: WIP: Add el-search-hi-lock.el

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit b43f7bb1a5c24279134006ce934499c0e2696711
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Add el-search-hi-lock.el
---
 packages/el-search/el-search-hi-lock.el | 310 
 packages/el-search/el-search.el |  26 ++-
 2 files changed, 332 insertions(+), 4 deletions(-)

diff --git a/packages/el-search/el-search-hi-lock.el 
b/packages/el-search/el-search-hi-lock.el
new file mode 100644
index 000..39fd1d6
--- /dev/null
+++ b/packages/el-search/el-search-hi-lock.el
@@ -0,0 +1,310 @@
+;;; el-search-hi-lock.el --- hi-lock with el-search patterns-*- 
lexical-binding: t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc
+
+;; Author: Michael Heerdegen 
+;; Maintainer: Michael Heerdegen 
+;; Created: 2018_01_14
+;; Keywords: lisp
+
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see .
+
+;;; Commentary:
+
+;; This file implements the counterpart of hi-lock.el for el-search
+;; patterns: Permanent highlighting of matches of specified patterns
+;; that is automatically updated when the buffer is edited.  Unlike
+;; hi-lock, and in contrast to what the name "el-search-hi-lock"
+;; suggests, we can't use font-lock for this purpose.  Instead, we use
+;; a timer to highlight the visible portions of the buffer.
+;;
+;; The entry points are `el-search-hi-lock-mode' to turn highlighting
+;; on and off, `el-search-hi-lock-add-pattern' to add patterns to be
+;; highlighted with specified faces (automatically turns on
+;; `el-search-hi-lock-mode'), and `el-search-hi-lock-remove-pattern'
+;; (removes patterns from the list of patterns to be highlighted).
+;;
+;; `el-search-hi-lock-add-pattern' can also be used in file and
+;; directory local variable specifications (with `eval').
+;;
+;; This is a bit slower than hi-lock.  Don't use it with too costly
+;; patterns to avoid Emacs becoming sluggish.
+
+;;; Code:
+
+(require 'el-search)
+(eval-when-compile (require 'subr-x))
+(require 'hi-lock) ;faces
+
+(defgroup el-search-hi-lock nil
+  "Doc..."
+  :group 'el-search)
+
+;; These faces definitions are stolen from Drew's "highlight.el"
+(defface el-search-hi-lock-decent-1
+  'background dark)) (:background "#33")) ;gray
+(t (:background "#BBEEBB"))) ;a light green
+  "Doc...")
+(defface el-search-hi-lock-decent-3
+  'background dark)) (:background "#04602BC0")) ; a very dark green
+(t (:background "#FCFCE1E1"))) ; a light magenta
+  "Doc...")
+(defface el-search-hi-lock-decent-2
+  'background dark)) (:background "#316B2297")) ; a very dark brown
+(t (:background "#E1E1EAEA"))) ; a light blue
+  "Doc...")
+(defface el-search-hi-lock-decent-4
+  'background dark)) (:background "#00234F")) ; a dark blue
+(t (:background "#E3FF9A"))) ; a light yellow
+  "Doc...")
+
+(defvar el-search-hi-lock-warning-time .1
+  "Doc...")
+
+
+(defvar-local el-search-hi-lock-current-patterns '()
+  "Elements have the form (PATTERN MATCHER HM FACE).")
+
+(defvar-local el-search-hi-lock-overlays '())
+(defvar el-search-hi-lock-extra-window-heights 1.)
+
+(defmacro el-search-hi-lock--while-no-input (&rest body)
+  "Like `while-no-input' but without preceding `input-pending-p' test."
+  (declare (debug t) (indent 0))
+  (let ((catch-sym (make-symbol "input")))
+`(with-local-quit
+   (catch ',catch-sym
+(let ((throw-on-input ',catch-sym))
+  ,@body)
+
+(defvar el-search-hi-lock-window-in-progress nil)
+
+(defun el-search-hi-lock-window (&optional window)
+  ;; Return done when successfully hi-locked without user interruption,
+  ;; error when catched an error
+  (cl-callf or window (selected-window))
+  (let ((el-search-hi-lock-window-in-progress t))
+(with-current-buffer (window-buffer window)
+  (condition-case nil
+  (let ((here (window-point window))
+(start (window-start window))
+(end  (window-end window t))
+(add-overlay (lambda (beg end face &optional priority)
+   (let ((ov (make-overlay beg end)))
+ (push ov el-search-hi-lock-overlays)
+ (overlay-put ov 'face face)
+ (overlay-put ov 'priority (or priority 
100)
+(delete-old-overlays
+

[elpa] scratch/mheerdegen-preview 7c82465 30/35: WIP: Fix C-A and C-J after finished single-buffer search

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 7c824656d4bcef84f64ca80d7614ac1480c0bdd9
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Fix C-A and C-J after finished single-buffer search
---
 packages/el-search/el-search.el | 90 -
 1 file changed, 52 insertions(+), 38 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 13d553d..c06f953 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -1478,9 +1478,20 @@ optional MESSAGE are used to construct the error 
message."
(eq (or buffer (current-buffer))
(el-search-head-buffer (el-search-object-head 
el-search--current-search)
 
+(defun el-search-revive-search ()
+  (el-search-hl-post-command-fun 'stop)
+  (setq el-search--success nil)
+  (setq el-search--wrap-flag nil)
+  (el-search-reset-search el-search--current-search))
+
 (defun el-search-barf-if-not-search-buffer (&optional buffer &rest args)
-  (unless (el-search--search-buffer-p buffer)
-(apply #'user-error (or args (list "Not in current search buffer")
+  (if (eq (alist-get 'is-single-buffer (el-search-object-properties 
el-search--current-search))
+   (current-buffer))
+  (unless (el-search-head-buffer (el-search-object-head 
el-search--current-search))
+(el-search-revive-search)
+(el-search--next-buffer el-search--current-search))
+(unless (el-search--search-buffer-p buffer)
+  (apply #'user-error (or args (list "Not in current search buffer"))
 
 (defun el-search--get-search-description-string (search &optional verbose 
dont-propertize)
   (concat
@@ -2865,8 +2876,8 @@ make current."
(el-search-hl-sexp)
(el-search-hl-other-matches (el-search--current-matcher)))
 (el-search--message-no-log "[Search completed - restarting]")
+(el-search-revive-search)
 (sit-for 1.5)
-(el-search-reset-search el-search--current-search)
 (el-search-continue-search))
   (el-search-prefix-key-maybe-set-transient-map))
 
@@ -3014,7 +3025,7 @@ See `el-search-defined-patterns' for a list of defined 
patterns."
   (el-search--set-wrap-flag nil)
   (el-search--message-no-log "[Wrapped search]")
   (sit-for .7)
-  (el-search-from-beginning 'restart)))
+  (el-search-from-beginning 1)))
((or
  (el-search--pending-search-p)
  (and (eq this-command last-command)
@@ -3023,12 +3034,13 @@ See `el-search-defined-patterns' for a list of defined 
patterns."
   (el-search--skip-expression nil t)
   (el-search-continue-search 'from-here)))
(t ;create a new search single-buffer search
-(el-search-setup-search
- pattern
- (let ((current-buffer (current-buffer)))
-   (lambda () (stream (list current-buffer
- (lambda (search) (setf (alist-get 'is-single-buffer 
(el-search-object-properties search)) t))
- 'from-here
+(let ((current-buffer (current-buffer)))
+  (el-search-setup-search
+   pattern
+   (lambda () (stream (list current-buffer)))
+   (lambda (search) (setf (alist-get 'is-single-buffer 
(el-search-object-properties search))
+  current-buffer))
+   'from-here)
 
 (defmacro el-search--unless-no-buffer-match (&rest body)
   "Execute BODY unless no match for current search in current buffer.
@@ -3179,12 +3191,13 @@ See the command `el-search-pattern' for more 
information."
   (progn
 (el-search-compile-pattern-in-search el-search--current-search)
 (el-search-prefix-key-maybe-set-transient-map))
-(el-search-setup-search-1
- pattern
- (let ((current-buffer (current-buffer)))
-   (lambda () (stream (list current-buffer
- 'from-here
- (lambda (search) (setf (alist-get 'is-single-buffer 
(el-search-object-properties search)) t)))
+(let ((current-buffer (current-buffer)))
+  (el-search-setup-search-1
+   pattern
+   (lambda () (stream (list current-buffer)))
+   'from-here
+   (lambda (search) (setf (alist-get 'is-single-buffer 
(el-search-object-properties search))
+  current-buffer
 ;; Make this buffer the current search buffer so that a following C-S
 ;; doesn't delete highlighting
 (el-search--next-buffer el-search--current-search))
@@ -3248,12 +3261,13 @@ Use the normal search commands to seize the search."
  (user-error "No sexp at point")))
   (let ((printed-sexp (el-search--pp-to-string sexp)))
 (el-search--pushnew-to-history (concat "'" printed-sexp) 
'el-search-pattern-history)
-(el-search-setup-search-1
- `',sexp
- (let ((current-buffer (current-buffer)))
-   (lambda () (stream (list current-buffer
- 'from-here
- (lambda (search) (setf (alist-get 'is-single-buffer 
(el-search-object-properties search)) t)))
+(let ((current-buffer (current-buffer)))
+  (el-s

[elpa] scratch/mheerdegen-preview e706a2a 27/35: WIP: Don't initially fold occur buffer

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit e706a2a8a0145c5515b1d84afbf9f91b7f0d11a0
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Don't initially fold occur buffer
---
 packages/el-search/el-search.el | 14 +++---
 1 file changed, 3 insertions(+), 11 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 28bc152..acebf86 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -272,9 +272,8 @@
 ;; match in that buffer or file.  With S-tab you can (un)collapse all
 ;; file sections like in `org-mode' to see only file names and the
 ;; number of matches, or everything.  Tab folds and unfolds
-;; expressions (this uses hideshow; initially, all expressions are
-;; folded to one line) and also sections at the beginning of
-;; headlines.
+;; expressions (this uses hideshow) and also sections at the beginning
+;; of headlines.
 ;;
 ;;
 ;; Multiple multi searches
@@ -3676,14 +3675,7 @@ Prompt for a new pattern and revert."
   (point) (el-search--end-of-sexp 
context-beg))
 
   (let ((inhibit-message t) (message-log-max nil))
-(indent-region insertion-point (point))
-(save-excursion
-  (goto-char insertion-point)
-  (ignore-errors
-;; This can error...
-(if nil ;if need-context
-(hs-hide-level 1)
-  (hs-hide-block)
+(indent-region insertion-point (point)))
   (insert "\n")))
 
   (save-excursion

[elpa] scratch/mheerdegen-preview c9085b6 29/35: WIP: Add alarm-clock.el

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit c9085b6ff5c918bf3395224add2d03d59a17c77c
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: Add alarm-clock.el
---
 packages/alarm-clock/alarm-clock.el | 653 
 1 file changed, 653 insertions(+)

diff --git a/packages/alarm-clock/alarm-clock.el 
b/packages/alarm-clock/alarm-clock.el
new file mode 100644
index 000..9602f64
--- /dev/null
+++ b/packages/alarm-clock/alarm-clock.el
@@ -0,0 +1,653 @@
+;;; alarm-clock.el --- Simple alarm clock-*- lexical-binding: t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc
+
+;; Author: Michael Heerdegen 
+;; Maintainer: Michael Heerdegen 
+;; Created: 27 Aug 2018
+;; Keywords: calendar
+;; Compatibility: GNU Emacs 25
+;; Version: 0.1
+;; Package-Requires: ()
+
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see .
+
+
+;;; Commentary:
+
+;; An alarm clock for Emacs.  Allows a bit more fine-tuning than
+;; appt.el.
+;;
+;; Add a new alarm clock with M-x alarm-clock-add.  You are prompted
+;; for a time or number of minutes and a name - e.g. enter "40" and
+;; "Cake" meaning "Tell me after 40 minutes that I should take the
+;; cake out of the hearth".  You get a countdown in the mode line
+;; (unless you turn the option alarm-clock-display-in-mode-line off),
+;; and a menu pops up when you click on it with mouse-3.  All other
+;; commands can be performed from that menu.
+;;
+;; You can have any number of alarm clocks - but you can also specify
+;; additional alarm times from the `alarm-clock-add' prompt for a
+;; single clock, for situations like "Tell me in 40 minutes that my
+;; cake is finished, but already after 30 minutes that I should reduce
+;; the heat".
+;;
+;; There are (canonically named) commands to pause, resume and remove
+;; an alarm clock (if a clock has multiple alarms, all of them are
+;; affected at the same time).  If an alarm time has come, you get an
+;; alarm.  Configure `alarm-clock-notify-function' to make that alarm
+;; fit your needs - the default just `ding's and displays a message.
+;;
+;; If you want to keep expired alarm-clocks until you explicitly
+;; remove them, configure `alarm-clock-autoremove ' to nil.  Expired
+;; clocks get a red face in the mode-line.  Finally, adding clocks
+;; with a running time of zero can serve as a simple kind of notes
+;; with timestamps.
+;;
+;; Configure `alarm-clock-default-alarms-alist' to predefine alarm
+;; clock name + duration associations.  These are available via
+;; completion in `alarm-clock-add'.
+;;
+;; Last but not least, configure `alarm-clock-use-save-file' to
+;; non-nil if you wish that alarm clocks survive Emacs restarts (or
+;; crashes).  In this case, alarm clocks are automatically saved to
+;; and restored from the file specified by
+;; `alarm-clock-save-file-name'.  You want to add an
+;; (alarm-clock-load) call to your init file in this case.  Since all
+;; Emacs instances share the configured save file, you should not
+;; manipulate alarm clocks in different Emacs instances in parallel.
+;;
+;;
+;; TODO:
+;;
+;; - Manchmal klingelts obwohl clock gelöscht?
+;;
+;; - Add a menu
+
+
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
+(require 'appt) ; appt-convert-time
+(require 'seq)
+
+
+(defgroup alarm-clock nil
+  "Simple alarm clock"
+  :group 'applications)
+
+(defcustom alarm-clock-display-in-mode-line t
+  "Doc..."
+  :type 'boolean)
+
+(defcustom alarm-clock-default-alarms-alist '()
+  "Doc..."
+  :type '(alist :key-type (string :tag "Name")
+:value-type (integer :tag "Minutes")))
+
+(defface alarm-clock-in-mode-line
+  'class color) (min-colors 88) (background dark))
+ :foreground "SeaGreen" :height .8)
+(((class color) (min-colors 88) (background light))
+ :foreground "DarkGreen" :height .8)
+(((class color) (min-colors 8) (background light))
+ :foreground "green")
+(((class color) (min-colors 8) (background dark))
+ :foreground "yellow"))
+  "Face for displaying alarm clocks in the mode-line.
+Only has an effect if `alarm-clock-display-in-mode-line' is
+non-nil.")
+
+(defface alarm-clock-paused-in-mode-line
+  'class color) (min-colors 88))
+ :foreground "RoyalBlue" :height .8)
+(((class color) (min-colors 8) (background light))
+ :foreground "

[elpa] scratch/mheerdegen-preview cdfaec4 35/35: WIP: [el-search] Change default of el-search-use-prefix-key-transient-map to t

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit cdfaec4cb1a83a0ca23cbd9cab5de6e87890c0bb
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP: [el-search] Change default of el-search-use-prefix-key-transient-map 
to t
---
 packages/el-search/el-search.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index e556cd9..9d07de6 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -590,7 +590,7 @@ from the prompt."
  (const :tag "On"  t)
  (const :tag "Ask" ask)))
 
-(defvar el-search-use-prefix-key-transient-map nil
+(defvar el-search-use-prefix-key-transient-map t
   "Whether el-search should make commands repeatable."
   ;; I originally wanted to make commands repeatable by looking at the
   ;; command keys.  But that got overly complicated: It interfered with
@@ -2081,6 +2081,7 @@ The following bindings are available only when a search 
is active:
 ;;;###autoload
 (defun el-search-install-shift-bindings ()
   (interactive)
+  (setq el-search-use-prefix-key-transient-map nil)
   (el-search-loop-over-bindings #'el-search-shift-bindings-bind-function)
   (define-key el-search-basic-transient-map [C-S-next]  
#'el-search-scroll-down)
   (define-key el-search-basic-transient-map [C-S-prior] #'el-search-scroll-up))

[elpa] scratch/mheerdegen-preview 869266f 15/35: WIP [el-search] Minibuffer hints when entering pattern, Fix case when search pattern fails for some sexps

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 869266f4a67fab6fd531cd7e2562146a1996ca92
Author: Michael Heerdegen 
Commit: Michael Heerdegen 

WIP [el-search] Minibuffer hints when entering pattern, Fix case when 
search pattern fails for some sexps
---
 packages/el-search/el-search.el | 512 ++--
 1 file changed, 335 insertions(+), 177 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 0b68741..117da55 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -471,6 +471,21 @@
   "Expression based search and replace for Emacs Lisp."
   :group 'lisp)
 
+(defcustom el-search-display-mb-hints t
+  "Whether to show hints in the search pattern prompt."
+  :type 'boolean)
+
+(defcustom el-search-mb-hints-delay 0.8
+  "Time before displaying minibuffer hints.
+
+Setting this has only an effect if `el-search-display-mb-hints'
+is non-nil."
+  :type 'number)
+
+(defcustom el-search-mb-hints-timeout 15
+  "How long to display minibuffer hints."
+  :type 'number)
+
 (defface el-search-match 'class color) (min-colors 88) (background dark))
 (:background "#60"))
   (((class color) (min-colors 88) (background light))
@@ -869,10 +884,13 @@ nil."
   input)
 (symbol-value histvar)
 
+(defun el-search--pattern-is-unquoted-symbol-p (pattern)
+  (and (symbolp pattern)
+   (not (eq pattern '_))
+   (not (keywordp pattern
+
 (defun el-search--maybe-warn-about-unquoted-symbol (pattern)
-  (when (and (symbolp pattern)
- (not (eq pattern '_))
- (not (keywordp pattern)))
+  (when (el-search--pattern-is-unquoted-symbol-p pattern)
 (message "Free variable `%S' (missing a quote?)" pattern)
 (sit-for 2.)))
 
@@ -882,7 +900,110 @@ nil."
 (el-search--pushnew-to-history input histvar)
 (if (not (string= input "")) input (car (symbol-value histvar)
 
-(defun el-search-read-pattern-for-interactive (&optional prompt)
+(defvar el-search--display-match-count-in-prompt nil)
+(defvar el-search--mb-hints-timer nil)
+(defvar el-search--reading-input-for-query-replace nil)
+
+(defun el-search-read-pattern-trigger-mb-hints ()
+  (if (not (timerp el-search--mb-hints-timer))
+  (setq el-search--mb-hints-timer (run-at-time 3 nil 
#'el-search-read-display-mb-hints))
+(timer-set-time el-search--mb-hints-timer (time-add (current-time) 
el-search-mb-hints-delay))
+(timer-activate el-search--mb-hints-timer)))
+
+(defun el-search-read-pattern-setup-mb-hints ()
+  (when el-search-display-mb-hints
+(when (timerp el-search--mb-hints-timer) (cancel-timer 
el-search--mb-hints-timer))
+(setq el-search--mb-hints-timer nil)
+(add-hook 'post-command-hook #'el-search-read-pattern-trigger-mb-hints t 
t)))
+
+(defvar el-search--search-pattern-1-do-fun nil)
+(defvar el-search--busy-animation
+  ;; '("." "o" "O" "o" "." " ")
+  ;; '("|" "/" "-" "\\")
+  '("*   " " *  " "  * " "   *" "  * " " *  "))
+
+(defun el-search--make-display-animation-function (display-fun)
+  (let ((last-update (seconds-to-time 0))
+(anim (copy-sequence el-search--busy-animation)))
+(setcdr (last anim) anim)
+(lambda ()
+  (let ((now (current-time)))
+(when (< .33 (float-time (time-subtract now last-update)))
+  (setq last-update now)
+  (funcall display-fun (pop anim)))
+
+(defun el-search-read-display-mb-hints ()
+  (when (minibufferp)
+(while-no-input
+  (let (err)
+(cl-macrolet ((try (&rest body)
+   (let ((err-data (make-symbol "err-data")))
+ `(condition-case ,err-data
+  (progn ,@body)
+(error (setq err ,err-data)
+   nil)
+  (let* ((input (minibuffer-contents))
+ (pattern (pcase (ignore-errors (read-from-string input))
+(`(,expr . ,(or (guard 
el-search--reading-input-for-query-replace)
+(pred (= (length input)
+ expr)))
+ (matcher (and pattern (try (el-search-make-matcher 
pattern)
+(let* ((base-win (minibuffer-selected-window))
+   (buf (window-buffer base-win)))
+  (if (and el-search--display-match-count-in-prompt matcher)
+  (progn (with-current-buffer buf
+   (setq el-search--current-search
+ (el-search-make-search
+  pattern
+  (let ((b (current-buffer)))
+(lambda () (stream (list b)))
+ (sit-for .3)
+ (let ((ol (make-overlay (point-max) (point-max) nil t 
t)))
+   (