[Emacs-diffs] master 2043e60 2/2: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

[Michael Albinus]

branch: master
commit 2043e6004cac26b8cfacf079cd31a1caa11a699d
Merge: 4f9fdb7 16e705b
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
---
 doc/emacs/buffers.texi            |   12 ++++++++++
 etc/NEWS                          |   18 +++++++++++++++
 lisp/bs.el                        |   43 +++++++++++++++++++++++++++++-----
 lisp/buff-menu.el                 |   46 +++++++++++++++++++++++++++++++++----
 lisp/ebuff-menu.el                |    3 +++
 lisp/emacs-lisp/tabulated-list.el |    6 +++++
 lisp/htmlfontify.el               |   30 ++++++++++++------------
 lisp/ibuffer.el                   |   14 +++++++----
 8 files changed, 142 insertions(+), 30 deletions(-)

diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index 2eb837f..c70e583 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -411,6 +411,18 @@ Remove all flags from the current line, and move down
 @kindex DEL @r{(Buffer Menu)}
 Move to the previous line and remove all flags on that line
 (@code{Buffer-menu-backup-unmark}).
+
address@hidden address@hidden
address@hidden Buffer-menu-unmark-all-buffers
address@hidden M-DEL @r{(Buffer Menu)}
+Remove a particular flag from all lines
+(@code{Buffer-menu-unmark-all-buffers}).
+
address@hidden U
address@hidden Buffer-menu-unmark-all
address@hidden U @r{(Buffer Menu)}
+Remove all flags from all the lines
+(@code{Buffer-menu-unmark-all}).
 @end table
 
 @noindent
diff --git a/etc/NEWS b/etc/NEWS
index 619d56b..02e93e4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -283,6 +283,24 @@ the file's actual content before prompting the user.
 
 * Changes in Specialized Modes and Packages in Emacs 26.1
 
+** Electric-Buffer-menu
+
++++
+*** Key 'U' is bound to 'Buffer-menu-unmark-all' and key 'M-DEL' is
+bound to 'Buffer-menu-unmark-all-buffers'.
+
+** bs
+
+---
+*** Two new commands 'bs-unmark-all', bound to 'U', and
+'bs-unmark-previous', bound to <backspace>.
+
+** Buffer-menu
+
++++
+*** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and
+'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'.
+
 ** Ibuffer
 
 ---
diff --git a/lisp/bs.el b/lisp/bs.el
index 8351169..d05a568 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -491,6 +491,8 @@ Used internally, only.")
     (define-key map "t"       'bs-visit-tags-table)
     (define-key map "m"       'bs-mark-current)
     (define-key map "u"       'bs-unmark-current)
+    (define-key map "U"       'bs-unmark-all)
+    (define-key map "\177"    'bs-unmark-previous)
     (define-key map ">"       'scroll-right)
     (define-key map "<"       'scroll-left)
     (define-key map "?"       'bs-help)
@@ -635,6 +637,8 @@ For faster navigation each digit key is a digit argument.
 \\[bs-clear-modified] -- clear modified-flag on that buffer.
 \\[bs-mark-current] -- mark current line's buffer to be displayed.
 \\[bs-unmark-current] -- unmark current line's buffer to be displayed.
+\\[bs-unmark-all] -- unmark all buffer lines.
+\\[bs-unmark-previous] -- unmark previous line's buffer to be displayed.
 \\[bs-show-sorted] -- display buffer list sorted by next sort aspect.
 \\[bs-set-configuration-and-refresh] -- ask user for a configuration and \
 apply selected configuration.
@@ -867,7 +871,7 @@ the status of buffer on current line."
 (defun bs-mark-current (count)
   "Mark buffers.
 COUNT is the number of buffers to mark.
-Move cursor vertically down COUNT lines."
+Move point vertically down COUNT lines."
   (interactive "p")
   (bs--mark-unmark count
                   (lambda (buf)
@@ -876,12 +880,39 @@ Move cursor vertically down COUNT lines."
 (defun bs-unmark-current (count)
   "Unmark buffers.
 COUNT is the number of buffers to unmark.
-Move cursor vertically down COUNT lines."
+Move point vertically down COUNT lines."
   (interactive "p")
   (bs--mark-unmark count
                   (lambda (buf)
                     (setq bs--marked-buffers (delq buf bs--marked-buffers)))))
 
+(defun bs-unmark-previous (count)
+  "Unmark previous COUNT buffers.
+Move point vertically up COUNT lines.
+When called interactively a numeric prefix argument sets COUNT."
+  (interactive "p")
+  (forward-line (- count))
+  (save-excursion (bs-unmark-current count)))
+
+(defun bs-unmark-all ()
+  "Unmark all buffers."
+  (interactive)
+  (let ((marked (string-to-char bs-string-marked))
+        (current (string-to-char bs-string-current))
+        (marked-cur (string-to-char bs-string-current-marked))
+        (unmarked (string-to-char bs-string-show-normally))
+        (inhibit-read-only t))
+    (save-excursion
+      (goto-char (point-min))
+      (forward-line 2)
+      (while (not (eobp))
+        (if (eq (char-after) marked)
+            (subst-char-in-region (point) (1+ (point)) marked unmarked)
+          (when (eq (char-after) marked-cur)
+            (subst-char-in-region (point) (1+ (point)) marked-cur current)))
+        (forward-line 1))
+      (setq bs--marked-buffers nil))))
+
 (defun bs--show-config-message (what)
   "Show message indicating the new showing status WHAT.
 WHAT is a value of nil, `never', or `always'."
@@ -973,14 +1004,14 @@ Uses function `read-only-mode'."
     (apply fun args)))
 
 (defun bs-up (arg)
-  "Move cursor vertically up ARG lines in Buffer Selection Menu."
+  "Move point vertically up ARG lines in Buffer Selection Menu."
   (interactive "p")
   (if (and arg (numberp arg) (< arg 0))
       (bs--nth-wrapper (- arg) 'bs--down)
     (bs--nth-wrapper arg 'bs--up)))
 
 (defun bs--up ()
-  "Move cursor vertically up one line.
+  "Move point vertically up one line.
 If on top of buffer list go to last line."
   (if (> (count-lines 1 (point)) bs-header-lines-length)
       (forward-line -1)
@@ -989,14 +1020,14 @@ If on top of buffer list go to last line."
     (recenter -1)))
 
 (defun bs-down (arg)
-  "Move cursor vertically down ARG lines in Buffer Selection Menu."
+  "Move point vertically down ARG lines in Buffer Selection Menu."
   (interactive "p")
   (if (and arg (numberp arg) (< arg 0))
       (bs--nth-wrapper (- arg) 'bs--up)
     (bs--nth-wrapper arg 'bs--down)))
 
 (defun bs--down ()
-  "Move cursor vertically down one line.
+  "Move point vertically down one line.
 If at end of buffer list go to first line."
   (if (eq (line-end-position) (point-max))
       (progn
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 4742628..e2aa2da 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -37,6 +37,12 @@
   :group 'tools
   :group 'convenience)
 
+(defvar Buffer-menu-marker-char ?>
+  "The mark character for marked buffers.")
+
+(defvar Buffer-menu-del-char ?D
+  "Character used to flag buffers for deletion.")
+
 (defcustom Buffer-menu-use-header-line t
   "If non-nil, use the header line to display Buffer Menu column titles."
   :type 'boolean
@@ -121,6 +127,8 @@ commands.")
     (define-key map "\177" 'Buffer-menu-backup-unmark)
     (define-key map "~" 'Buffer-menu-not-modified)
     (define-key map "u" 'Buffer-menu-unmark)
+    (define-key map "\M-\177" 'Buffer-menu-unmark-all-buffers)
+    (define-key map "U" 'Buffer-menu-unmark-all)
     (define-key map "m" 'Buffer-menu-mark)
     (define-key map "t" 'Buffer-menu-visit-tags-table)
     (define-key map "%" 'Buffer-menu-toggle-read-only)
@@ -197,6 +205,12 @@ commands.")
     (bindings--define-key menu-map [umk]
       '(menu-item "Unmark" Buffer-menu-unmark
                 :help "Cancel all requested operations on buffer on this line 
and move down"))
+    (bindings--define-key menu-map [umkab]
+      '(menu-item "Remove marks..." Buffer-menu-unmark-all-buffers
+                  :help "Cancel a requested operation on all buffers"))
+    (bindings--define-key menu-map [umka]
+      '(menu-item "Unmark all" Buffer-menu-unmark-all
+                  :help "Cancel all requested operations on buffers"))
     (bindings--define-key menu-map [mk]
       '(menu-item "Mark" Buffer-menu-mark
                 :help "Mark buffer on this line for being displayed by v 
command"))
@@ -239,6 +253,8 @@ In Buffer Menu mode, the following commands are defined:
 \\[Buffer-menu-execute]    Delete or save marked buffers.
 \\[Buffer-menu-unmark]    Remove all marks from current line.
      With prefix argument, also move up one line.
+\\[Buffer-menu-unmark-all-buffers]    Remove a particular mark from all lines.
+\\[Buffer-menu-unmark-all]    Remove all marks from all lines.
 \\[Buffer-menu-backup-unmark]  Back up a line and remove marks.
 \\[Buffer-menu-toggle-read-only]    Toggle read-only status of buffer on this 
line.
 \\[revert-buffer]    Update the list of buffers.
@@ -328,7 +344,7 @@ is nil or omitted, and signal an error otherwise."
 (defun Buffer-menu-no-header ()
   (beginning-of-line)
   (if (or Buffer-menu-use-header-line
-         (not (eq (char-after) ?C)))
+         (not (tabulated-list-header-overlay-p (point))))
       t
     (ding)
     (forward-line 1)
@@ -346,7 +362,7 @@ is nil or omitted, and signal an error otherwise."
   "Mark the Buffer menu entry at point for later display.
 It will be displayed by the \\<Buffer-menu-mode-map>\\[Buffer-menu-select] 
command."
   (interactive)
-  (tabulated-list-set-col 0 ">" t)
+  (tabulated-list-set-col 0 (char-to-string Buffer-menu-marker-char) t)
   (forward-line))
 
 (defun Buffer-menu-unmark (&optional backup)
@@ -356,6 +372,28 @@ Optional prefix arg means move up."
   (Buffer-menu--unmark)
   (forward-line (if backup -1 1)))
 
+(defun Buffer-menu-unmark-all-buffers (mark)
+  "Cancel a requested operation on all buffers.
+MARK is the character to flag the operation on the buffers.
+When called interactively prompt for MARK;  RET remove all marks."
+  (interactive "cRemove marks (RET means all):")
+  (save-excursion
+    (goto-char (point-min))
+    (when (tabulated-list-header-overlay-p)
+      (forward-line))
+    (while (not (eobp))
+      (let ((xmarks (list (aref (tabulated-list-get-entry) 0)
+                          (aref (tabulated-list-get-entry) 2))))
+        (when (or (char-equal mark ?\r)
+                  (member (char-to-string mark) xmarks))
+          (Buffer-menu--unmark)))
+      (forward-line))))
+
+(defun Buffer-menu-unmark-all ()
+  "Cancel all requested operations on buffers."
+  (interactive)
+  (Buffer-menu-unmark-all-buffers ?\r))
+
 (defun Buffer-menu-backup-unmark ()
   "Move up and cancel all requested operations on buffer on line above."
   (interactive)
@@ -382,12 +420,12 @@ buffers to delete; a negative ARG means to delete 
backwards."
       (setq arg 1))
   (while (> arg 0)
     (when (Buffer-menu-buffer)
-      (tabulated-list-set-col 0 "D" t))
+      (tabulated-list-set-col 0 (char-to-string Buffer-menu-del-char) t))
     (forward-line 1)
     (setq arg (1- arg)))
   (while (< arg 0)
     (when (Buffer-menu-buffer)
-      (tabulated-list-set-col 0 "D" t))
+      (tabulated-list-set-col 0 (char-to-string Buffer-menu-del-char) t))
     (forward-line -1)
     (setq arg (1+ arg))))
 
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
index 5536f94..74a9dd5 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -55,6 +55,8 @@
     (define-key map "\177" 'Buffer-menu-backup-unmark)
     (define-key map "~" 'Buffer-menu-not-modified)
     (define-key map "u" 'Buffer-menu-unmark)
+    (define-key map "\M-\177" 'Buffer-menu-unmark-all-buffers)
+    (define-key map "U" 'Buffer-menu-unmark-all)
     (let ((i ?0))
       (while (<= i ?9)
        (define-key map (char-to-string i) 'digit-argument)
@@ -114,6 +116,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry.
 \\[Buffer-menu-save] -- mark that buffer to be saved.
 \\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer 
to be deleted.
 \\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
+\\[Buffer-menu-unmark-all] -- remove all kinds of marks from all lines.
 \\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
 \\[Buffer-menu-backup-unmark] -- back up a line and remove marks."
   (interactive "P")
diff --git a/lisp/emacs-lisp/tabulated-list.el 
b/lisp/emacs-lisp/tabulated-list.el
index cf297f1..9523d5e 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -259,6 +259,12 @@ Do nothing if `tabulated-list--header-string' is nil."
                     (make-overlay (point-min) (point))))
       (overlay-put tabulated-list--header-overlay 'face 'underline))))
 
+(defsubst tabulated-list-header-overlay-p (&optional pos)
+  "Return non-nil if there is a fake header.
+Optional arg POS is a buffer position where to look for a fake header;
+defaults to `point-min'."
+  (overlays-at (or pos (point-min))))
+
 (defun tabulated-list-revert (&rest ignored)
   "The `revert-buffer-function' for `tabulated-list-mode'.
 It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 08d1dd2..5ffbb6d 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -81,7 +81,7 @@
 ;; Changes: moved to changelog (CHANGES) file.
 
 ;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 (require 'faces)
 ;;  (`facep' `face-attr-construct' `x-color-values' `color-values' `face-name')
 (require 'custom)
@@ -818,7 +818,7 @@ regular specifiers."
   (if spec
       (let ((tag (car  spec))
             (val (cadr spec)))
-        (cons (case tag
+        (cons (cl-case tag
                 (:color (cons "colour" val))
                 (:width (cons "width"  val))
                 (:style (cons "style"  val)))
@@ -831,7 +831,7 @@ regular specifiers."
     (list
      (if col (cons "border-color" (cdr (assoc "colour" css))))
      (cons "border-width" (format "%dpx" (or (cdr (assoc "width" css)) 1)))
-     (cons "border-style" (case s
+     (cons "border-style" (cl-case s
                             (released-button "outset")
                             (pressed-button  "inset" )
                             (t               "solid" ))))))
@@ -850,7 +850,7 @@ TAG is an Emacs font attribute key (eg :underline).
 VAL is ignored."
   (list
    ;; FIXME: Why not '("text-decoration" . "underline")?  --Stef
-   (case tag
+   (cl-case tag
      (:underline      (cons "text-decoration" "underline"   ))
      (:overline       (cons "text-decoration" "overline"    ))
      (:strike-through (cons "text-decoration" "line-through")))))
@@ -1003,7 +1003,7 @@ merged by the user - `hfy-flatten-style' should do this."
                    (hfy-face-to-style-i
                     (hfy-face-attr-for-class v hfy-display-class))))))
         (setq this
-              (if val (case key
+              (if val (cl-case key
                        (:family         (hfy-family    val))
                        (:width          (hfy-width     val))
                        (:weight         (hfy-weight    val))
@@ -1287,7 +1287,7 @@ return a `defface' style list of face properties instead 
of a face symbol."
                             (setq fprops (cdr fprops)))
                         ;; ((prop val))
                         (setq p (caar fprops))
-                        (setq v (cadar fprops))
+                        (setq v (cl-cadar fprops))
                         (setq fprops (cdr fprops)))
                     (if (listp (cdr fprops))
                         (progn
@@ -1304,7 +1304,7 @@ return a `defface' style list of face properties instead 
of a face symbol."
                             (setq v (cdr fprops))
                             (setq fprops nil))
                         (error "Eh... another format! fprops=%s" fprops) )))
-                  (setq p (case p
+                  (setq p (cl-case p
                             ;; These are all the properties handled
                             ;; in `hfy-face-to-style-i'.
                             ;;
@@ -1407,8 +1407,8 @@ Returns a modified copy of FACE-MAP."
     ;;(push (car  tmp-map) reduced-map)
     ;;(push (cadr tmp-map) reduced-map)
     (while tmp-map
-      (setq first-start (cadddr tmp-map)
-            first-stop  (caddr  tmp-map)
+      (setq first-start (cl-cadddr tmp-map)
+            first-stop (cl-caddr tmp-map)
             last-start  (cadr   tmp-map)
             last-stop   (car    tmp-map)
             map-buf      tmp-map
@@ -1421,8 +1421,8 @@ Returns a modified copy of FACE-MAP."
                     (not (re-search-forward "[^ \t\n\r]" (car last-start) t))))
         (setq map-buf     (cddr map-buf)
               span-start  first-start
-              first-start (cadddr map-buf)
-              first-stop  (caddr  map-buf)
+              first-start (cl-cadddr map-buf)
+              first-stop (cl-caddr map-buf)
               last-start  (cadr   map-buf)
               last-stop   (car    map-buf)))
       (push span-stop  reduced-map)
@@ -1762,7 +1762,7 @@ FILE, if set, is the file name."
             (if (not (setq pr (get-text-property pt lp))) nil
               (goto-char pt)
               (remove-text-properties pt (1+ pt) (list lp nil))
-              (case lp
+              (cl-case lp
                 (hfy-link
                  (if (setq rr (get-text-property pt 'hfy-inst))
                      (insert (format "<a name=\"%s\"></a>" rr)))
@@ -1805,7 +1805,7 @@ It is assumed that STRING has text properties that allow 
it to be
 fontified.  This is a simple convenience wrapper around
 `htmlfontify-buffer'."
   (let* ((hfy-optimizations-1 (copy-sequence hfy-optimizations))
-         (hfy-optimizations (pushnew 'skip-refontification 
hfy-optimizations-1)))
+         (hfy-optimizations (cl-pushnew 'skip-refontification 
hfy-optimizations-1)))
     (with-temp-buffer
       (insert string)
       (htmlfontify-buffer)
@@ -1825,7 +1825,7 @@ fontified.  This is a simple convenience wrapper around
     (if (fboundp 'font-lock-ensure)
         (font-lock-ensure)
       (when font-lock-defaults
-        (font-lock-ensure))))
+        (font-lock-fontify-buffer))))
    ((fboundp #'jit-lock-fontify-now)
     (message "hfy jit-lock mode (%S %S)" window-system major-mode)
     (jit-lock-fontify-now))
@@ -1962,7 +1962,7 @@ property, with a value of \"tag.line-number\"."
             (lambda (TLIST)
               (if (string= file (car TLIST))
                   (let* ((line              (cadr TLIST) )
-                         (chr              (caddr TLIST) )
+                         (chr (cl-caddr TLIST))
                          (link (format "%s.%d" TAG line) ))
                     (put-text-property (+ 1 chr)
                                        (+ 2 chr)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index faadb67..dc5681c 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -1556,19 +1556,23 @@ If point is on a group name, this function operates on 
that group."
     (if (or elide (with-no-warnings ibuffer-elide-long-columns))
        `(if (> strlen 5)
             ,(if from-end-p
+                  ;; FIXME: this should probably also be using
+                  ;; `truncate-string-to-width' (Bug#24972)
                  `(concat ,ellipsis
                           (substring ,strvar
                                      (string-width ibuffer-eliding-string)))
-               `(truncate-string-to-width
-                 ,strvar strlen nil nil
-                 ,ellipsis))
+               `(concat
+                 (truncate-string-to-width
+                   ,strvar (- strlen (string-width ,ellipsis)) nil ?.)
+                  ,ellipsis))
           ,strvar)
       strvar)))
 
 (defun ibuffer-compile-make-substring-form (strvar maxvar from-end-p)
   (if from-end-p
-      `(truncate-string-to-width str (string-width str) (- strlen ,maxvar))
-    `(truncate-string-to-width ,strvar ,maxvar)))
+      ;; FIXME: not sure if this case is correct (Bug#24972)
+      `(truncate-string-to-width str (string-width str) (- strlen ,maxvar) nil 
?\s)
+    `(truncate-string-to-width ,strvar ,maxvar nil ?\s)))
 
 (defun ibuffer-compile-make-format-form (strvar widthform alignment)
   (let* ((left `(make-string tmp2 ?\s))