[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/zones 353fc38: Fix Emacs-22 miscompilation
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/zones 353fc38: Fix Emacs-22 miscompilation |
|
Date: |
Sun, 6 Jan 2019 22:32:00 -0500 (EST) |
branch: externals/zones
commit 353fc38a6544eb59887bee045e373406f1d038a5
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
Fix Emacs-22 miscompilation
(condition-case-unless-debug): Use full macro definition for Emacs 22, to
prevent compiler mishandling.
(zz-izone-limits): IZONES arg is no longer optional - explicit list of
izones,
so can handle null izones.
(zz-narrow): Correctly handle negative arg when no more zones to pop off.
(zz-add-zones-matching-regexp): let*, not let.
Protect isearchp-dim-outside-search-area-flag with bound-and-true-p.
(zz-choose-zone-by-id-and-text, zz-dotted-zones-from-izones,
zz-order-zones):
New commands. Regroup some definitions.
(zz-add-zone): Do not add if zone would cover whole buffer.
Use zz-user-error, not error.
(zz-set-zones-from-face): Remove unused arg MSGP.
(zz-(do|map)-(i)zones): Add arg UNITE-P - do not unite by default.
---
zones.el | 2543 ++++++++++++++++++++++++++++++++------------------------------
1 file changed, 1314 insertions(+), 1229 deletions(-)
diff --git a/zones.el b/zones.el
index 99f8b79..1bf94f0 100644
--- a/zones.el
+++ b/zones.el
@@ -1,17 +1,17 @@
;;; zones.el --- Zones of text - like multiple regions
;;
-;; Copyright (C) 2010-2018 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2019 Free Software Foundation, Inc.
;;
;; Filename: zones.el
;; Description: Zones of text - like multiple regions
;; Author: Drew Adams
;; Maintainer: Drew Adams <address@hidden>
;; Created: Sun Apr 18 12:58:07 2010 (-0700)
-;; Version: 2018.11.21
+;; Version: 2018.12.28
;; Package-Requires: ()
-;; Last-Updated: Wed Nov 21 06:57:27 2018 (-0800)
+;; Last-Updated: Fri Dec 28 10:11:11 2018 (-0800)
;; By: dradams
-;; Update #: 2644
+;; Update #: 2961
;; URL: https://elpa.gnu.org/packages/zones.html
;; URL: https://www.emacswiki.org/emacs/download/zones.el
;; Doc URL: https://www.emacswiki.org/emacs/Zones
@@ -21,8 +21,7 @@
;;
;; Features that might be required by this library:
;;
-;; `backquote', `bytecomp', `cconv', `cl', `cl-lib', `gv',
-;; `macroexp'.
+;; None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -66,7 +65,13 @@
;; (@> "Keys")
;; (@> "Command `zz-narrow-repeat'")
;; (@> "Define Your Own Commands")
-;; (@> "Change log")
+;; (@> "Change Log")
+;; (@> "Compatibility Code for Older Emacs Versions")
+;; (@> "Variables and Faces")
+;; (@> "Advice for Standard Functions")
+;; (@> "General Commands")
+;; (@> "General Non-Interactive Functions")
+;; (@> "Key Bindings")
;;(@* "Things Defined Here")
;;
@@ -100,16 +105,18 @@
;;
;; `zz-add-key-bindings-to-narrow-map', `zz-buffer-narrowed-p'
;; (Emacs 22-23), `zz-buffer-of-markers', `zz-car-<',
-;; `zz-do-izones', `zz-do-zones', `zz-dot-pairs', `zz-every',
-;; `zz-izone-has-other-buffer-marker-p', `zz-izone-limits',
-;; `zz-izone-limits-in-bufs', `zz-izones-from-noncontiguous-region'
-;; (Emacs 25+), `zz-izones-from-zones', `zz-izone-p', `zz-izones-p',
+;; `zz-choose-zone-by-id-and-text', `zz-do-izones',
+;; `zz-dotted-zones-from-izones', `zz-do-zones', `zz-dot-pairs',
+;; `zz-every', `zz-izone-has-other-buffer-marker-p',
+;; `zz-izone-limits', `zz-izone-limits-in-bufs',
+;; `zz-izones-from-noncontiguous-region' (Emacs 25+),
+;; `zz-izones-from-zones', `zz-izone-p', `zz-izones-p',
;; `zz-izones-renumber', `zz-map-izones', `zz-map-zones',
;; `zz-marker-from-object', `zz-markerize', `zz-max', `zz-min',
;; `zz-narrow-advice', `zz-narrowing-lighter',
;; `zz-noncontiguous-region-from-izones',
;; `zz-noncontiguous-region-from-zones', `zz-number-or-marker-p',
-;; `zz-overlays-to-zones', `zz-overlay-to-zone',
+;; `zz-order-zones', `zz-overlays-to-zones', `zz-overlay-to-zone',
;; `zz-overlay-union', `zz-rassoc-delete-all',
;; `zz-readable-marker', `zz-readable-marker-p',
;; `zz-read-any-variable', `zz-read-bufs', `zz-regexp-car-member',
@@ -160,9 +167,8 @@
;; ** Compatibility **
;;
;; Some of the functions defined here are not available for Emacs
-;; versions prior to Emacs 22. Others are not available for versions
-;; prior to Emacs 23. Still others are available only starting with
-;; Emacs 25. This is mentioned where applicable.
+;; versions prior to 23. Still others are available only starting
+;; with Emacs 25. This is mentioned where applicable.
;;
;;
;;(@* "Zones")
@@ -439,7 +445,7 @@
;; C-x n u `zz-unite-zones' - Unite (coalesce) zones
;; C-x n v `zz-set-izones-var' - Set current zones-set variable
;; C-x n w `widen'
-;; C-x n x `zz-narrow-repeat' - Cycle zones as buffer narrowing
+;; C-x n x `zz-narrow-repeat' - Cycle or pop zones as narrowings
;; C-x n C-x `zz-select-zone-repeat' - Cycle zones as active region
;;
;;
@@ -452,10 +458,10 @@
;; added to the izone list of the current buffer (by default,
;; buffer-local variable `zz-izones').
;;
-;; You can then use `C-x n x' to cycle among previous buffer
-;; narrowings. Repeating `x' repeats the action: `C-x n x x x x'
-;; etc. Each time you hit `x' a different narrowing is made current.
-;; This gives you an easy way to browse your past narrowings.
+;; You can then use `C-x n x' to cycle or pop previous narrowings.
+;; Repeating `x' repeats the action: `C-x n x x x x' etc. Each time
+;; you hit `x' a different narrowing is made current. This gives you
+;; an easy way to browse your past narrowings.
;;
;; If the izone variable is not buffer-local then `zz-narrow-repeat'
;; can cycle among the narrowings in different buffers, switching the
@@ -470,10 +476,14 @@
;; resets (empties) the current izone variable.
;;
;; * A numeric prefix arg N takes you directly to the abs(N)th
-;; previous buffer narrowing. That is, it widens abs(N) times.
-;; Positive and negative args work the same, except that a negative
-;; arg also pops entries off the ring: it removes the ring entries
-;; from the most recent back through the (-)Nth one.
+;; previous buffer narrowing. That is, it acts abs(N) times.
+;;
+;; A negative arg work like a positive one, except that it also pops
+;; entries off the ring: it removes entries from the most recent back
+;; through the (-)Nth one. For example, `C-- C-x n x x x' pops the
+;; last added narrowing each time you hit `x'. You can thus use the
+;; list of recorded zones as a narrowing stack: narrow commands push
+;; to the stack, and `C-- C-x n x' pops it.
;;
;; By default, `C-x n x' is bound to command `zz-narrow-repeat'.
;; (For Emacs versions prior to 22 it is bound by default to
@@ -529,7 +539,10 @@
;; (defun hlt-highlight-regions (&optional regions face msgp mousep
;; buffers)
;; "Apply `hlt-highlight-region' to regions in `zz-izones'."
-;; (interactive (list (zz-izone-limits) nil t current-prefix-arg))
+;; (interactive (list (zz-izone-limits zz-izones)
+;; nil
+;; t
+;; current-prefix-arg))
;; (dolist (start+end regions)
;; (hlt-highlight-region (nth 0 start+end) (nth 1 start+end)
;; face msgp mousep buffers)))
@@ -542,8 +555,20 @@
;;
;;; Change Log:
;;
-;;(@* "Change log")
-;;
+;;(@* "Change Log")
+;;
+;; 2018/12/28 dadams
+;; Fix condition-case-unless-debug for Emacs 22. Use full macro
definition, to prevent E22 compiler warning.
+;; zz-izone-limits: IZONES arg is no longer optional - explicit list of
izones, so can handle null izones.
+;; zz-narrow: Correctly handle negative arg when no more zones to pop off.
+;; zz-add-zones-matching-regexp:
+;; let*, not let. Protect isearchp-dim-outside-search-area-flag with
bound-and-true-p.
+;; 2018/12/10 dadams
+;; Added: zz-choose-zone-by-id-and-text, zz-dotted-zones-from-izones,
zz-order-zones.
+;; Regrouped some definitions.
+;; zz-add-zone: Do not add if zone would cover whole buffer. Use
zz-user-error, not error.
+;; zz-set-zones-from-face: Removed unused arg MSGP.
+;; zz-(do|map)-(i)zones: Added arg UNITE-P - do not unite by default.
;; 2018/11/21 dadams
;; Added: zz-add-zones-matching-regexp, zz-set-zones-matching-regexp,
zz-toggles-map,
;; condition-case-unless-debug alias.
@@ -855,6 +880,7 @@
;; Quiet the byte-compiler.
(defvar hlt-last-face) ; In `highlight.el'
+(defvar isearchp-dim-outside-search-area-flag) ; In `isearch+.el'
(defvar mode-line-modes) ; Emacs 22+
(defvar narrow-map) ; Emacs 23+
(defvar region-extract-function) ; Emacs 25+
@@ -862,14 +888,46 @@
(defvar repeat-previous-repeated-command) ; In `repeat.el'
;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(unless (fboundp 'condition-case-unless-debug) ; Emacs 22-23.
- (defalias 'condition-case-unless-debug 'condition-case-no-debug))
-(defalias 'zz-user-error
- (if (fboundp 'user-error) #'user-error #'error)) ; For Emacs 22-23.
+
+;;(@* "Compatibility Code for Older Emacs Versions")
+
+;;; Compatibility Code for Older Emacs Versions ----------------------
+
+;; When byte-compiled by Emacs 22 this gives a false-positive unbound-variable
warning.
+;; (unless (fboundp 'condition-case-unless-debug)
+;; (defalias 'condition-case-unless-debug (if (fboundp
'condition-case-no-debug)
+;; 'condition-case-no-debug ;
Emacs 23
+;; 'condition-case))) ; Emacs 22
+
+(unless (fboundp 'condition-case-unless-debug)
+ (defmacro condition-case-unless-debug (var bodyform &rest handlers)
+ "Like `condition-case' except that it does not prevent debugging.
+More specifically if `debug-on-error' is set then the debugger will be invoked
+even if this catches the signal."
+ (declare (debug condition-case) (indent 2)) ;
+ `(condition-case ,var
+ ,bodyform
+ ,@(mapcar (lambda (handler)
+ `((debug ,@(if (listp (car handler)) (car handler) (list
(car handler))))
+ ,@(cdr handler)))
+ handlers))))
+
+(defalias 'zz-user-error (if (fboundp 'user-error) #'user-error #'error)) ;
For Emacs 22-23.
+
+(defalias 'zz-buffer-narrowed-p (if (fboundp 'buffer-narrowed-p) ; For Emacs
22-23.
+ #'buffer-narrowed-p
+ (lambda () (/= (- (point-max) (point-min))
(buffer-size)))))
+
+(defalias 'zz-string-match-p (if (fboundp 'string-match-p) ; For Emacs 22.
+ #'string-match-p
+ (lambda (regexp string &optional start)
+ "Like `string-match', but this saves and
restores the match data."
+ (save-match-data (string-match regexp string
start)))))
+
+;;(@* "Variables and Faces")
+;;; Variables and Faces ----------------------------------------------
(defgroup zones nil
"Zones of text - like multiple regions."
@@ -956,486 +1014,411 @@ cons whose care is the abstract (a string).")
(defvar zz-zone-abstract-limit 68
"Max number of chars of zone text to include in default zone abstract.")
+
+;;(@* "Advice for Standard Functions")
-(defun zz-zone-abstract-function-default (izone)
- "Default value of `zz-zone-abstract-function'.
-The abstract it produces for IZONE is (the absolute value of) the zone
-ID, followed by the first `zz-zone-abstract-limit' chars of the zone
-text. The return value of the function is a cons, (ABSTRACT . IZONE),
-whose car is the abstract and whose cdr is the izone."
- (let ((id (abs (car izone)))
- (beg (cadr izone))
- (end (caddr izone)))
- (cons (format "%d %s" id (buffer-substring beg (min (+ beg
zz-zone-abstract-limit) end))) izone)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Advice for Standard Functions ------------------------------------
-(defun zz-zone-ordered (zone)
- "Return ZONE or ZONE with its car and cadr reversed, so car <= cadr.
-The cddr of ZONE remains as it was."
- (let ((beg (car zone))
- (end (cadr zone))
- (extra (cddr zone)))
- (when (zz-readable-marker-p beg) (setq beg (nth 2 beg)))
- (when (zz-readable-marker-p end) (setq end (nth 2 end)))
- (if (<= beg end) zone `(,end ,beg ,@extra))))
+(defun zz-narrow-advice (interactive-p)
+ "Advice for narrowing functions.
+Call `zz-add-zone' if interactive or if `zz-add-zone-anyway-p'."
+ (when (or interactive-p zz-add-zone-anyway-p)
+ (zz-add-zone (point-min) (point-max) nil nil nil "Narrowed, and recorded
zone: ")))
-(defun zz-zones-overlap-p (zone1 zone2)
- "Return non-nil if ZONE1 and ZONE2 overlap.
-Assumes that each zone is ordered (its car <= its cadr).
-The cddrs are ignored.
+(defadvice narrow-to-region (after zz-add-zone--region activate)
+ "Push the region limits to the current `zz-izones-var'.
+You can use `C-x n x' to widen to a previous buffer restriction.
-Zones that use markers do not overlap if the marker buffers differ."
- (and (zz-zones-same-buffer-name-p zone1 zone2)
- (progn (when (< (car zone2) (car zone1)) (setq zone1 (prog1 zone2 (setq
zone2 zone1))))
- (<= (car zone2) (cadr zone1)))))
+This is a destructive operation. The list structure of the variable
+value can be modified."
+ (zz-narrow-advice (interactive-p)))
-(defun zz-zones-same-buffer-name-p (zone1 zone2)
- "Return non-nil if ZONE1 and ZONE2 apply to the same buffer.
-This is the case if `zz-zone-buffer-name' returns the same name for
-each. (A buffer with that name need not exist.)"
- (eq (zz-zone-buffer-name zone1) (zz-zone-buffer-name zone2)))
+(defadvice narrow-to-defun (after zz-add-zone--defun activate)
+ "Push the defun limits to the current `zz-izones-var'.
+You can use `C-x n x' to widen to a previous buffer restriction.
-(defun zz-zone-buffer-name (zone)
- "Return the name of the buffer used by ZONE.
-If the two ZONE positions specify different buffers, or if either is a
-marker that points nowhere, then raise an error."
- (let* ((lim1 (car zone))
- (lim2 (cadr zone))
- (buf1 (cond ((markerp lim1) (and (marker-buffer lim1)
- (buffer-name
(marker-buffer lim1))))
- ((zz-readable-marker-p lim1) (cadr lim1))
- (t (buffer-name
(current-buffer)))))
- (buf2 (cond ((markerp lim2) (and (marker-buffer lim2)
- (buffer-name
(marker-buffer lim2))))
- ((zz-readable-marker-p lim2) (cadr lim2))
- (t (buffer-name
(current-buffer))))))
- (unless (and buf1 buf2) (error "Zone has marker(s) that point nowhere:
%S" zone))
- (unless (equal buf1 buf2) (error "Zone has conflicting buffers: %S" zone))
- buf1))
+This is a destructive operation. The list structure of the variable
+value can be modified."
+ (zz-narrow-advice (interactive-p)))
-(defun zz-do-zones (function &optional zones)
- "Like `zz-map-zones', but without returning the result of mapping.
-The return value is undefined."
- (when (functionp function)
- (when (zz-izones-p zones) (setq zones (zz-izone-limits zones nil
'ONLY-THIS-BUFFER)))
- (setq zones (zz-zone-union zones))
- (dolist (zone zones) (funcall function (car zone) (cadr zone)))))
+;; Call `zz-add-zone' if interactive or `zz-add-zone-anyway-p'.
+;;
+(defadvice narrow-to-page (after zz-add-zone--defun activate)
+ "Push the page limits to the current `zz-izones-var'.
+You can use `C-x n x' to widen to a previous buffer restriction.
-(defun zz-map-zones (function &optional zones)
- "Map binary FUNCTION over ZONES, applying it to the limits of each zone.
-ZONES can be a list of basic zones or a list like `zz-izones', that
-is, zones that have identifiers. By default, ZONES is the value of
-`zz-izones'."
- (if (not (functionp function))
- (or zones zz-izones)
- (when (zz-izones-p zones) (setq zones (zz-izone-limits zones nil
'ONLY-THIS-BUFFER)))
- (setq zones (zz-zone-union zones))
- (mapcar (lambda (zone) (funcall function (car zone) (cadr zone))) zones)))
+This is a destructive operation. The list structure of the variable
+value can be modified."
+ (zz-narrow-advice (interactive-p)))
+
+;;(@* "General Commands")
-(defun zz-do-izones (function &optional izones)
- "Like `zz-map-izones', but without returning the result of mapping.
-The return value is undefined."
- (when (functionp function)
- (setq izones (zz-unite-zones izones))
- (dolist (izone izones) (funcall function (car izone) (cadr izone) (caddr
izone)))))
+;;; General Commands -------------------------------------------------
-(defun zz-map-izones (function &optional izones)
- "Map FUNCTION over IZONES.
-Apply FUNCTION to the first three elements of each izone, that is, the
- identifier and the zone limits.
-IZONES is a list like `zz-izones', that is, zones with identifiers.
-By default, IZONES is the value of `zz-izones'."
- (if (not (functionp function))
- (or izones zz-izones)
- (setq izones (zz-unite-zones izones))
- (mapcar (lambda (izone) (funcall function (car izone) (cadr izone) (caddr
izone))) izones)))
+;;;###autoload
+(defalias 'zz-select-region-by-id-and-text #'zz-select-zone-by-id-and-text)
+;;;###autoload
+(defun zz-select-zone-by-id-and-text (id &optional variable msgp) ; Bound to
`C-x n #'
+ "Select a zone by completing against its ID and its text (content).
+The text of the chosen zone is made the active region.
-(defun zz-zones-complement (zones &optional beg end)
- "Return a list of zones that is the complement of ZONES, from BEG to END.
-ZONES is assumed to be a union, i.e., sorted by car, with no overlaps.
-Any extra info in a zone of ZONES, i.e., after the cadr, is ignored."
- (setq beg (zz-marker-from-object (or beg (point-min)))
- end (zz-marker-from-object (or end (point-max))))
- (let ((res ()))
- (dolist (zone zones)
- (push (list beg (car zone)) res)
- (setq beg (cadr zone)))
- (setq res (nreverse (push (list beg end) res)))))
+The zones to choose from are those of VARIABLE that are in the current
+buffer. VARIABLE defaults to the value of `zz-izones-var'. With a
+prefix arg you are prompted for a different variable to use.
-(defun zz-two-zone-union (zone1 zone2)
- "Return the union of ZONE1 and ZONE2, or nil if they do not overlap.
-Assumes that each zone is ordered (its car <= its cadr).
+Non-interactively:
+* VARIABLE is the optional izones variable to use.
+* Non-nil MSGP means show a status message."
+ (interactive
+ (let* ((var (or (and current-prefix-arg (zz-read-any-variable
"Variable: " zz-izones-var t))
+ zz-izones-var))
+ (izones (zz-remove-izones-w-other-buffer-markers (symbol-value
var)))
+ (num (string-to-number (completing-read "Zone: "
+ (mapcar
zz-zone-abstract-function izones) nil t))))
+ (list num var t)))
+ (let* ((izone (assq (- id) (zz-remove-izones-w-other-buffer-markers
(symbol-value variable))))
+ (beg (cadr izone))
+ (end (caddr izone)))
+ (goto-char beg)
+ (push-mark end nil t)
+ (when msgp (message "Izone #%d selected" (car izone)))))
-The cddr of a non-nil result (its EXTRA information, which must be a
-list) is the union of the EXTRA information of each zone:
+;;;###autoload
+(defalias 'zz-select-region #'zz-select-zone)
+;;;###autoload
+(defun zz-select-zone (arg &optional msgp) ; Not bound.
+ "Select a zone in `zz-izones-var', and make it the active region.
+With no prefix arg, select the last-recorded zone.
+With a numeric prefix arg N, select the Nth last-recorded zone.
- (zz-set-union (cddr zone1) (cddr zone2))
+Note that if the value of `zz-izones-var' is not buffer-local then you
+can use this command to cycle among zones in multiple buffers."
+ (interactive "p\np")
+ (let* ((var zz-izones-var)
+ (val (symbol-value var))
+ (cntr (abs arg))
+ (len (length val)))
+ (unless (cadr val) (error "No zone to select"))
+ (when (> cntr len)
+ (when msgp (message "Only %d zones available. Using zone #%d" len len)
(sit-for 1))
+ (setq cntr (min cntr len)))
+ (let ((latest ()))
+ (while (> cntr 0)
+ (push (nth (1- cntr) val) latest)
+ (setq cntr (1- cntr)))
+ (setq latest (nreverse latest))
+ (setq val (set var (append (nthcdr arg val) latest))
+ val (set var (mapcar #'zz-markerize val)))
+ (let* ((izone (car val))
+ (beg (nth 1 izone))
+ (end (nth 2 izone))
+ (other-buf nil))
+ (when (and (not (local-variable-p var))
+ (setq other-buf (zz-izone-has-other-buffer-marker-p
izone)) ; Returns marker or nil.
+ (or (not (markerp beg)) (not (markerp end)) (eq
(marker-buffer beg) (marker-buffer end)))
+ (setq other-buf (marker-buffer other-buf)))
+ (pop-to-buffer other-buf))
+ (goto-char beg)
+ (push-mark end nil t)
+ (when msgp
+ (message "Selected zone #%d (in zone-creation order)%s"
+ (caar val) (if other-buf (format " in `%s'" other-buf)
"")))))))
-This is a non-destructive operation: The result is a new list."
- (and (zz-zones-overlap-p zone1 zone2) `(,(zz-min (car zone1) (car zone2))
- ,(zz-max (cadr zone1) (cadr zone2))
- ,@(zz-set-union (cddr zone1) (cddr
zone2)))))
+;; This is a non-destructive operation.
+;;
+;;;###autoload
+(defun zz-narrow (arg &optional msgp) ; Not bound.
+ "Widen to a previous buffer restriction (narrowing).
+The candidates are the zones in the current `zz-izones-var'.
-(defun zz-zone-union (zones &optional buffer)
- "Return the union (coalescence) of the zones in list ZONES.
-Each element of ZONES is a list of two zone limits, possibly followed
-by extra info: (LIMIT1 LIMIT2 . EXTRA), where EXTRA is a list.
-The limits need not be in numerical order.
+With no prefix arg, widen to the previous narrowing.
+With a plain prefix arg (`C-u'), widen completely.
+With a zero prefix arg (`C-0'), widen completely and reset (empty)
+ the list of zones for this buffer.
+With a numeric prefix arg N, widen abs(N) times (to the abs(N)th
+ previous narrowing). Positive and negative args work the same,
+ except that a negative arg also pops entries off the ring: it removes
+ the ring entries from the most recent back through the (-)Nth one."
+ (interactive "P\np")
+ (let* ((var zz-izones-var)
+ (val (symbol-value var)))
+ (unless val (error "No previous narrowing"))
+ (cond ((or (consp arg) (and (null (cdr val)) (zz-buffer-narrowed-p)))
+ (widen)
+ (setq zz-lighter-narrowing-part "")
+ (zz-narrowing-lighter)
+ (when msgp (message "No longer narrowed")))
+ ((= (prefix-numeric-value arg) 0)
+ (set var ())
+ (widen)
+ (setq zz-lighter-narrowing-part "")
+ (zz-narrowing-lighter)
+ (when msgp (message "No longer narrowed; no more narrowings")))
+ (t
+ (setq arg (prefix-numeric-value arg))
+ (let ((latest ())
+ (cntr (abs arg)))
+ (while (> cntr 0)
+ (push (nth (1- cntr) val) latest)
+ (setq cntr (1- cntr)))
+ (setq latest (nreverse latest))
+ (when (< arg 0) (setq arg (abs arg)
+ latest ()))
+ (setq val (set var (append (nthcdr arg
val) latest))
+ val (set var (mapcar #'zz-markerize
val)))
+ (cond (val
+ (setq zz-lighter-narrowing-part (format "-%d" (caar
val)))
+ (condition-case err
+ (let* ((zz-add-zone-anyway-p t)
+ (izone (car val))
+ (beg (nth 1 izone))
+ (end (nth 2 izone))
+ (other-buf nil))
+ (when (and (not (local-variable-p var))
+ (setq other-buf
(zz-izone-has-other-buffer-marker-p izone)) ; Marker or nil.
+ (or (not (markerp beg)) (not (markerp
end))
+ (eq (marker-buffer beg)
(marker-buffer end))) ; Same other buffer.
+ (setq other-buf (marker-buffer
other-buf)))
+ (pop-to-buffer other-buf))
+ (narrow-to-region beg end)
+ (zz-narrowing-lighter))
+ (args-out-of-range (set var (cdr val))
+ (error "Restriction removed because
of invalid limits"))
+ (error (error "%s" (error-message-string err)))))
+ (t ; No zones now. E.g., negative ARG popped off the last
one.
+ (widen)
+ (setq zz-lighter-narrowing-part "")
+ (zz-narrowing-lighter)
+ (when msgp (message "No longer narrowed")))))))))
-Each limit can be a number or a marker, but zones with markers for
-buffers other than BUFFER (default: current buffer) are ignored.
+;;;###autoload
+(defun zz-add-zone (start end &optional variable not-buf-local-p set-var-p
msg) ; Bound to `C-x n a'.
+ "Add an izone for the text from START to END to the izones of VARIABLE.
+But do not add a zone if it would cover the entire buffer.
+Return the new value of VARIABLE.
-Any zones that use markers for a buffer other than BUFFER (default:
-current buffer) are excluded.
+This is a destructive operation: The list structure of the variable
+value can be modified.
-Returns a new list, which is sorted by the lower limit of each zone,
-which is its car. (This is a non-destructive operation.)
+VARIABLE defaults to the value of `zz-izones-var'.
+START and END are as for `narrow-to-region'.
-Each zone in ZONES is first ordered, so that its car <= its cadr.
-The resulting zones are then sorted by their cars.
+With a prefix arg you are prompted for a different variable to use, in
+place of the current value of `zz-izones-var'. The particular prefix
+arg determines whether the variable, if unbound, is made buffer-local,
+and whether `zz-izones-var' is set to the variable symbol:
-`zz-two-zone-union' is then applied recursively to coalesce
-overlapping or adjacent zones. This means also that any EXTRA info is
-combined whenever zones are merged together."
- (let* ((filtered-zones (zz-remove-zones-w-other-buffer-markers zones
buffer))
- (flipped-zones (mapcar #'zz-zone-ordered filtered-zones))
- (sorted-zones (sort flipped-zones #'zz-car-<)))
- (zz-zone-union-1 sorted-zones)))
+ prefix arg buffer-local set `zz-izones-var'
+ ---------- ------------ -------------------
+ Plain `C-u' yes yes
+ > 0 (e.g. `C-1') yes no
+ = 0 (e.g. `C-0') no yes
+ < 0 (e.g. `C--') no no
-;; Recursive version.
-;; (defun zz-zone-union-1 (zones)
-;; "Helper for `zz-zone-union'."
-;; (if (null (cdr zones))
-;; zones
-;; (let ((new (zz-two-zone-union (car zones) (cadr zones))))
-;; (if new
-;; (zz-zone-union-1 (cons new (cddr zones)))
-;; (cons (car zones) (zz-zone-union-1 (cdr zones)))))))
+Non-interactively:
+* VARIABLE is the optional izones variable to use.
+* Non-nil NOT-BUF-LOCAL-P means do not make VARIABLE buffer-local.
+* Non-nil SET-VAR-P means set `zz-izones-var' to VARIABLE.
+* Non-nil MSG means echo the zone limits, preceded by string MSG."
+ (interactive (let* ((beg (region-beginning))
+ (end (region-end))
+ (var (or (and current-prefix-arg
(zz-read-any-variable "Variable: " zz-izones-var))
+ zz-izones-var))
+ (npref (prefix-numeric-value current-prefix-arg))
+ (nloc (and current-prefix-arg (<= npref 0) (not
(boundp var))))
+ (setv (and current-prefix-arg (or (consp
current-prefix-arg) (= npref 0)))))
+ (list beg end var nloc setv "Recorded zone: ")))
+ (let* ((mrk1 (make-marker))
+ (mrk2 (make-marker))
+ (var (or variable zz-izones-var))
+ (_IGNORE (unless (or not-buf-local-p (boundp var))
(make-local-variable var)))
+ (_IGNORE (when set-var-p (setq zz-izones-var var)))
+ (_IGNORE (unless (boundp var) (set var ())))
+ (val (symbol-value var))
+ sans-id id-cons id izone)
+ (unless (zz-izones-p val) (zz-user-error "Not an izones variable: `%s',
value: `%S'" var val))
+ (move-marker mrk1 start)
+ (move-marker mrk2 end)
+ (setq sans-id (list mrk1 mrk2)
+ id-cons (rassoc sans-id val)
+ id (if id-cons (car id-cons) (- (1+ (length val)))) ; 1-based,
not 0-based.
+ val (set var (zz-rassoc-delete-all sans-id val))) ; Destructive
operation.
+ (when (and (= mrk1 1) (= mrk2 (1+ (buffer-size))))
+ (zz-user-error "Zone not created - it would cover whole buffer"))
+ (setq izone `(,id ,mrk1 ,mrk2))
+ (set var `(,izone ,@val))
+ (when msg (message "%s%d to %d" msg (marker-position mrk1)
(marker-position mrk2)))
+ (symbol-value var)))
-(defun zz-zone-union-1 (zones)
- "Helper for `zz-zone-union'."
- (if (null (cdr zones))
- zones
- (let ((acc ())
- new)
- (while zones
- (setq new (and (cdr zones) (zz-two-zone-union (car zones) (cadr
zones))))
- (if new
- (setq zones (cons new (cddr zones)))
- (setq acc (cons (car zones) acc)
- zones (cdr zones))))
- (setq acc (nreverse acc)))))
+;;;###autoload
+(defun zz-delete-zone (id &optional variable msgp) ; Bound to `C-x n C-d'.
+ "Delete a zone by completing against its ID and its text (content).
+Delete the zone from VARIABLE, and renumber those remaining.
+Return the new value of VARIABLE.
-(defun zz-car-< (zone1 zone2)
- "Return non-nil if car of ZONE1 < car of ZONE2.
-Each car can be a number or a marker.
+This is a destructive operation: The list structure of the variable
+value can be modified.
-* Two numbers or two markers in the same buffer: Use `<'.
-* Two markers in different buffers: Use `string<' of the buffer names.
-* Only one is a marker:
- If its buffer is current then treat it as a number, using `<'.
- Else return false if the marker is for ZONE1 and return true if it
- is for ZONE2."
- (let* ((p1 (car zone1))
- (p2 (car zone2))
- (m1 (markerp p1))
- (m2 (markerp p2))
- (b1 (and m1 (marker-buffer p1)))
- (b2 (and m2 (marker-buffer p2))))
- (cond ((and (not m1) (not m2)) (< p1 p2))
- ((and m1 m2) (if (eq b1 b2) (< p1 p2) (string< (buffer-name b1)
(buffer-name b2))))
- (m1 (and (eq (current-buffer) b1) (< p1 p2)))
- (m2 (or (not (eq (current-buffer) b2)) (< p1 p2))))))
+VARIABLE defaults to the value of `zz-izones-var'. With a prefix arg
+you are prompted for a different variable to use.
-(defun zz-two-zone-intersection (zone1 zone2)
- "Return intersection of ZONE1 and ZONE2.
-\(The result is nil if they do not overlap.)
-Assumes that each zone is ordered (its car <= its cadr).
+Non-nil optional arg NOMSG means do not display a status message."
+ (interactive
+ (let* ((var (or (and current-prefix-arg (zz-read-any-variable
"Variable: " zz-izones-var t))
+ zz-izones-var))
+ (izones (symbol-value var))
+ (_IGNORE (unless (zz-izones-p izones)
+ (error "Not an izones variable: `%s', value: `%S'" var
izones)))
+ (_IGNORE (unless izones (error "No zones - variable `%s' is empty"
var)))
+ (len (length izones))
+ (num (if (= len 1)
+ 1
+ (string-to-number (completing-read (format "Delete zone
with ID (1 to %d): " len)
+ (mapcar
zz-zone-abstract-function izones) nil t)))))
+ (list num var t)))
+ (unless variable (setq variable zz-izones-var))
+ (let ((izones (symbol-value variable)))
+ (unless (zz-izones-p izones) (error "Not an izones variable: `%s', value:
`%S'" variable izones))
+ (unless izones (error "No zones - variable `%s' is empty" variable))
+ (set variable (assq-delete-all (- id) izones)))
+ (zz-izones-renumber variable)
+ (when msgp (message "Deleted zone with ID %d" id))
+ (symbol-value variable))
-The cddr of a non-nil result (its list of EXTRA information) is the
-intersection of the EXTRA information of each zone:
+;;;###autoload
+(defun zz-narrow-repeat () ; Bound to `C-x n x'.
+ "Cycle to the next buffer restriction (narrowing).
+This is a repeatable version of `zz-narrow'.
- (zz-set-intersection (cddr zone1) (cddr zone2))
+Note that if the value of `zz-izones-var' is not buffer-local then you
+can use this command to cycle among zones in multiple buffers."
+ (interactive)
+ (zz-repeat-command 'zz-narrow))
-This is a non-destructive operation: The result is a new list."
- (and (zz-zones-overlap-p zone1 zone2) `(,(zz-max (car zone1) (car zone2))
- ,(zz-min (cadr zone1) (cadr zone2))
- ,@(zz-set-intersection (cddr
zone1) (cddr zone2)))))
+;;;###autoload
+(defalias 'zz-select-region-repeat #'zz-select-zone-repeat)
+;;;###autoload
+(defun zz-select-zone-repeat () ; Bound to `C-x n C-x'.
+ "Cycle to the next zone, and make it the active region.
+Zones are cycled in chronological order of their recording.
+This is a repeatable version of `zz-select-zone'."
+ (interactive)
+ (zz-repeat-command 'zz-select-zone))
-(defun zz-zone-intersection (zones)
- "Return the intersection of the zones in list ZONES.
-Each element of ZONES is a list of two zone limits, possibly followed
-by extra info: (LIMIT1 LIMIT2 . EXTRA), where EXTRA is a list.
+;;;###autoload
+(defun zz-set-izones-var (variable &optional localp) ; Bound to `C-x n v'
+ "Set `zz-izones-var' to VARIABLE, for which you are prompted.
+With a prefix arg, make VARIABLE automatically be buffer-local."
+ (interactive (list (zz-read-any-variable "Variable: " zz-izones-var)
current-prefix-arg))
+ (setq zz-izones-var variable)
+ (when localp (make-variable-buffer-local variable)))
-The limits do not need to be in numerical order.
+;;;###autoload
+(defun zz-clone-zones (from-variable to-variable &optional msgp) ; Bound to
`C-x n c'
+ "Clone FROM-VARIABLE to TO-VARIABLE.
+Return the new value of TO-VARIABLE.
+That is, copy the zones of FROM-VARIABLE to (emptied) TO-VARIABLE.
+A non-destructive operation: The value of TO-VARIABLE is a new list,
+ with only the zones from FROM-VARIABLE.
+Return the value of TO-VARIABLE.
-Returns a new list, which is sorted by the lower limit of each zone,
-which is its car. (This is a non-destructive operation.)
+You are prompted for FROM-VARIABLE and TO-VARIABLE.
-Each zone in ZONES is first ordered, so that its car <= its cadr.
-The resulting zones are then sorted by their cars.
+With a non-negative (>= 0) prefix arg, make TO-VARIABLE buffer-local.
+With a non-positive (<= 0) prefix arg, set `zz-izones-var' to the
+TO-VARIABLE symbol. (Zero: do both.)
-`zz-two-zone-intersection' is then applied recursively to combine
-overlapping zones. This means also that any EXTRA info is combined
-when zones are merged together."
- (let* ((flipped-zones (mapcar #'zz-zone-ordered zones))
- (sorted-zones (sort flipped-zones (lambda (z1 z2) (< (car z1) (car
z2))))))
- (zz-zone-intersection-1 sorted-zones)))
+FROM-VARIABLE defaults to the value of `zz-izones-var'.
-(defun zz-zone-intersection-1 (zones)
- "Helper for `zz-zone-intersection'."
- (if (null (cdr zones))
- zones
- (let ((new (zz-two-zone-intersection (car zones) (cadr zones))))
- (and new (zz-zone-intersection-1 (cons new (cddr zones)))))))
+Non-interactively: Non-nil MSGP means show a status message."
+ (interactive
+ (let ((from-var (zz-read-any-variable "Copy variable: " zz-izones-var t))
+ (to-var (zz-read-any-variable "To variable: "))
+ (npref (and current-prefix-arg (prefix-numeric-value
current-prefix-arg))))
+ (when (and npref (>= npref 0)) (make-local-variable to-var))
+ (when (and npref (<= npref 0)) (setq zz-izones-var to-var))
+ (list from-var to-var t)))
+ (prog1 (set to-variable (copy-sequence (symbol-value from-variable)))
+ (when msgp (message "Cloned `%s' to `%s'" from-variable to-variable))))
-;; From `cl-seq.el', function `union', without keyword treatment.
-(defun zz-set-union (list1 list2)
- "Combine LIST1 and LIST2 using a set-union operation.
-The result list contains all items that appear in either LIST1 or
-LIST2. This is a non-destructive function: it copies the data if
-necessary."
- (cond ((null list1) list2)
- ((null list2) list1)
- ((equal list1 list2) list1)
- (t
- (unless (>= (length list1) (length list2)) (setq list1 (prog1 list2
(setq list2 list1)))) ; Swap.
- (while list2
- (unless (member (car list2) list1) (setq list1 (cons (car list2)
list1)))
- (setq list2 (cdr list2)))
- list1)))
+;;;###autoload
+(defalias 'zz-clone-and-coalesce-zones #'zz-clone-and-unite-zones)
+;;;###autoload
+(defun zz-clone-and-unite-zones (from-variable to-variable &optional msgp) ;
Bound to `C-x n C'
+ "Clone FROM-VARIABLE to TO-VARIABLE, then unite (coalesce) TO-VARIABLE.
+That is, use`zz-clone-zones' to fill TO-VARIABLE, then use
+`zz-unite-zones' on TO-VARIABLE.
-;; From `cl-seq.el', function `intersection', without keyword treatment.
-(defun zz-set-intersection (list1 list2)
- "Set intersection of lists LIST1 and LIST2.
-This is a non-destructive operation: it copies the data if necessary."
- (and list1 list2
- (if (equal list1 list2)
- list1
- (let ((result ()))
- (unless (>= (length list1) (length list2)) (setq list1 (prog1
list2 (setq list2 list1)))) ; Swap.
- (while list2
- (when (member (car list2) list1) (setq result (cons (car list2)
result)))
- (setq list2 (cdr list2)))
- result))))
+Just as for `zz-clone-zones':
+ With a non-negative (>= 0) prefix arg, make TO-VARIABLE buffer-local.
+ With a non-positive (<= 0) prefix arg, set `zz-izones-var' to the
+ TO-VARIABLE symbol. (Zero: do both.)
-(defun zz-min (&rest ns)
- "Like `min', but if the args include a marker then return a marker.
-Raise an error if the args include markers from different buffers."
- (let ((buf (zz-buffer-of-markers ns))
- (min (apply #'min ns)))
- (if (not buf)
- min
- (with-current-buffer (get-buffer-create buf)
- (set-marker (copy-marker min) min buf)))))
+United zones are in ascending order of their cars.
+Return the new value of TO-VARIABLE.
-(defun zz-max (&rest ns)
- "Like `max', but if the args include a marker then return a marker.
-Raise an error if the args include markers from different buffers."
- (let ((buf (zz-buffer-of-markers ns))
- (max (apply #'max ns)))
- (if (not buf)
- max
- (with-current-buffer (get-buffer-create buf) (set-marker (copy-marker
max) max buf)))))
+Use this when you do not want to unite the zones of FROM-VARIABLE (for
+example, you want to use them as possibly overlapping buffer
+narrowings), but you also want to act on the united zones (for
+example, to search them).
-(defun zz-buffer-of-markers (ns)
- "Return the buffer of the markers in list NS, or nil if no markers.
-Raise an error if NS contains markers from different buffers."
- (let ((mkr (car (zz-some #'markerp ns))))
- (and mkr
- (progn
- (unless (zz-every (lambda (nn) (or (not (markerp nn)) (eq
(marker-buffer nn) (marker-buffer mkr)))) ns)
- (error "List contains markers from different buffers"))
- t)
- (marker-buffer mkr))))
+FROM-VARIABLE defaults to the value of `zz-izones-var'.
-;; Similar to `every' in `cl-extra.el', without non-list sequences and multiple
-;; sequences.
-(defun zz-every (predicate list)
- "Return t if PREDICATE is true for all elements of LIST; else nil."
- (while (and list (funcall predicate (car list))) (setq list (cdr list)))
- (null list))
-
-;; Same as `bmkp-some' in `bookmark+-1.el'.
-;; This is NOT the same as `some' in `cl-extra.el', even without non-list
sequences and multiple sequences.
-;;
-;; If PREDICATE is satisfied by a list element ELEMENT, so that it returns a
non-nil value VALUE for ELEMENT,
-;; then this returns the cons (ELEMENT . VALUE). It does not return just
VALUE.
-(defun zz-some (predicate list)
- "Return non-nil if PREDICATE applied to some element of LIST is true.
-The value returned is a cons, (ELEMENT . VALUE), where ELEMENT is the
-first list element that satisfies PREDICATE and VALUE is the value of
-PREDICATE applied to ELEMENT."
- (let (elt val)
- (catch 'zz-some
- (while list
- (when (setq val (funcall predicate (setq elt (pop list))))
- (throw 'zz-some (cons elt val))))
- nil)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;
+Non-interactively: Non-nil MSGP means show a status message."
+ (interactive
+ (let ((from-var (zz-read-any-variable "Copy variable: " zz-izones-var t))
+ (to-var (zz-read-any-variable "To variable: "))
+ (npref (and current-prefix-arg (prefix-numeric-value
current-prefix-arg))))
+ (when (and npref (>= npref 0)) (make-local-variable to-var))
+ (when (and npref (<= npref 0)) (setq zz-izones-var to-var))
+ (list from-var to-var t)))
+ (set to-variable (copy-sequence (symbol-value from-variable)))
+ (prog1 (zz-unite-zones to-variable)
+ (when msgp (message "Cloned `%s' to `%s' and united `%s'" from-variable
to-variable to-variable))))
;;;###autoload
-(defalias 'zz-select-region-by-id-and-text #'zz-select-zone-by-id-and-text)
+(defalias 'zz-coalesce-zones #'zz-unite-zones)
;;;###autoload
-(defun zz-select-zone-by-id-and-text (id &optional variable msgp) ; Bound to
`C-x n #'
- "Select a zone by completing against its ID and its text (content).
-The text of the chosen zone is made the active region.
+(defun zz-unite-zones (&optional variable msgp) ; Bound to `C-x n u'
+ "Coalesce (unite) the izones of VARIABLE.
+A non-destructive operation: The new value of VARIABLE is a new list.
+Return the new value of VARIABLE.
-The zones to choose from are those of VARIABLE that are in the current
-buffer. VARIABLE defaults to the value of `zz-izones-var'. With a
-prefix arg you are prompted for a different variable to use.
+United zones are in ascending order of their cars.
+
+VARIABLE defaults to the value of `zz-izones-var'.
+With a prefix arg you are prompted for a different variable to use, in
+place of the current value of `zz-izones-var'. If the prefix arg is
+non-negative (>= 0) then make the variable buffer-local. If the
+prefix arg is non-positive (<= 0) then set `zz-izones-var' to that
+variable symbol. (Zero: do both.)
Non-interactively:
* VARIABLE is the optional izones variable to use.
* Non-nil MSGP means show a status message."
- (interactive
- (let* ((var (or (and current-prefix-arg (zz-read-any-variable
"Variable: " zz-izones-var t))
- zz-izones-var))
- (izones (zz-remove-izones-w-other-buffer-markers (symbol-value
var)))
- (num (string-to-number (completing-read "Zone: "
- (mapcar
zz-zone-abstract-function izones) nil t))))
- (list num var t)))
- (let* ((izone (assq (- id) (zz-remove-izones-w-other-buffer-markers
(symbol-value variable))))
- (beg (cadr izone))
- (end (caddr izone)))
- (goto-char beg)
- (push-mark end nil t)
- (when msgp (message "Izone #%d selected" (car izone)))))
-
-;;;###autoload
-(defalias 'zz-select-region #'zz-select-zone)
-;;;###autoload
-(defun zz-select-zone (arg &optional msgp) ; Not bound.
- "Select a zone in `zz-izones-var', and make it the active region.
-With no prefix arg, select the last-recorded zone.
-With a numeric prefix arg N, select the Nth last-recorded zone.
-
-Note that if the value of `zz-izones-var' is not buffer-local then you
-can use this command to cycle among zones in multiple buffers."
- (interactive "p\np")
- (let* ((var zz-izones-var)
- (val (symbol-value var))
- (cntr (abs arg))
- (len (length val)))
- (unless (cadr val) (error "No zone to select"))
- (when (> cntr len)
- (when msgp (message "Only %d zones available. Using zone #%d" len len)
(sit-for 1))
- (setq cntr (min cntr len)))
- (let ((latest ()))
- (while (> cntr 0)
- (push (nth (1- cntr) val) latest)
- (setq cntr (1- cntr)))
- (setq latest (nreverse latest))
- (setq val (set var (append (nthcdr arg val) latest))
- val (set var (mapcar #'zz-markerize val)))
- (let* ((izone (car val))
- (beg (nth 1 izone))
- (end (nth 2 izone))
- (other-buf nil))
- (when (and (not (local-variable-p var))
- (setq other-buf (zz-izone-has-other-buffer-marker-p
izone)) ; Returns marker or nil.
- (or (not (markerp beg)) (not (markerp end)) (eq
(marker-buffer beg) (marker-buffer end)))
- (setq other-buf (marker-buffer other-buf)))
- (pop-to-buffer other-buf))
- (goto-char beg)
- (push-mark end nil t)
- (when msgp
- (message "Selected zone #%d (in zone-creation order)%s"
- (caar val) (if other-buf (format " in `%s'" other-buf)
"")))))))
+ (interactive (let* ((var (and current-prefix-arg (zz-read-any-variable
"Variable: " zz-izones-var t)))
+ (npref (prefix-numeric-value current-prefix-arg)))
+ (when (and current-prefix-arg (>= npref 0))
(make-local-variable var))
+ (when (and current-prefix-arg (<= npref 0)) (setq
zz-izones-var var))
+ (list var t)))
+ (let* ((var (or variable zz-izones-var))
+ (_IGNORE (unless (boundp var) (set var ())))
+ (val (symbol-value var))
+ (_IGNORE (unless (zz-izones-p val) (error "Not an izones
variable: `%s', value: `%S'" var val)))
+ (zone-union (zz-zone-union (zz-izone-limits val))))
+ (set var (zz-izones-from-zones zone-union))
+ (when msgp
+ (let ((len (length (symbol-value var))))
+ (message "Zones united for variable `%s': %d zone%s now" var len (if
(> len 1) "s" ""))))
+ (symbol-value var)))
-;; This is a non-destructive operation.
-;;
;;;###autoload
-(defun zz-narrow (arg &optional msgp) ; Not bound.
- "Widen to a previous buffer restriction (narrowing).
-The candidates are the zones in the current `zz-izones-var'.
-
-With no prefix arg, widen to the previous narrowing.
-With a plain prefix arg (`C-u'), widen completely.
-With a zero prefix arg (`C-0'), widen completely and reset (empty)
- the list of zones for this buffer.
-With a numeric prefix arg N, widen abs(N) times (to the abs(N)th
- previous narrowing). Positive and negative args work the same,
- except that a negative arg also pops entries off the ring: it removes
- the ring entries from the most recent back through the (-)Nth one."
- (interactive "P\np")
- (let* ((var zz-izones-var)
- (val (symbol-value var)))
- (unless val (error "No previous narrowing"))
- (cond ((or (consp arg) (and (null (cdr val)) (zz-buffer-narrowed-p)))
- (widen)
- (setq zz-lighter-narrowing-part "")
- (zz-narrowing-lighter)
- (when msgp (message "No longer narrowed")))
- ((= (prefix-numeric-value arg) 0)
- (set var ())
- (widen)
- (setq zz-lighter-narrowing-part "")
- (zz-narrowing-lighter)
- (when msgp (message "No longer narrowed; no more narrowings")))
- (t
- (setq arg (prefix-numeric-value arg))
- (let ((latest ())
- (cntr (abs arg)))
- (while (> cntr 0)
- (push (nth (1- cntr) val) latest)
- (setq cntr (1- cntr)))
- (setq latest (nreverse latest))
- (when (< arg 0) (setq arg (abs arg)
- latest ()))
- (setq val (set var (append (nthcdr arg
val) latest))
- val (set var (mapcar #'zz-markerize
val))
- zz-lighter-narrowing-part (format "-%d" (caar val)))
- (condition-case err
- (let* ((zz-add-zone-anyway-p t)
- (izone (car val))
- (beg (nth 1 izone))
- (end (nth 2 izone))
- (other-buf nil))
- (when (and (not (local-variable-p var))
- (setq other-buf
(zz-izone-has-other-buffer-marker-p izone)) ; Marker or nil.
- (or (not (markerp beg)) (not (markerp end))
- (eq (marker-buffer beg) (marker-buffer
end))) ; Same other buffer.
- (setq other-buf (marker-buffer other-buf)))
- (pop-to-buffer other-buf))
- (narrow-to-region beg end)
- (zz-narrowing-lighter))
- (args-out-of-range (set var (cdr val))
- (error "Restriction removed because of
invalid limits"))
- (error (error "%s" (error-message-string err)))))))))
-
-(defun zz-narrowing-lighter ()
- "Update minor-mode mode-line lighter to reflect narrowing/widening.
-Put `zz-narrow' on `mouse-2' for the lighter suffix."
- (let* ((%n-cons (zz-regexp-car-member "%n\\(.*\\)\\'" mode-line-modes)))
- (when %n-cons
- (setcar %n-cons (replace-regexp-in-string "%n\\(.*\\)"
- (if (zz-buffer-narrowed-p)
zz-lighter-narrowing-part "")
- (car %n-cons) nil nil 1))
- (when (> (length (car %n-cons)) 2)
- (set-text-properties 2
- (length (car %n-cons))
- '(local-map (keymap (mode-line keymap (mouse-2 .
zz-narrow)))
- mouse-face mode-line-highlight
- help-echo "mouse-2: Next Restriction")
- (car %n-cons)))
- ;; Dunno why we need to do this. Tried adjusting `rear-sticky' and
`front-sticky',
- ;; but without this the whole field (not just the suffix) gets changed,
in effect, to the above spec.
- (set-text-properties 0 2 '(local-map (keymap (mode-line keymap (mouse-2
. mode-line-widen)))
- mouse-face mode-line-highlight help-echo
"mouse-2: Widen")
- (car %n-cons)))))
-
-(defun zz-regexp-car-member (regexp xs)
- "Like `member', but tests by matching REGEXP against cars."
- (and (consp xs) (if (and (stringp (car xs)) (zz-string-match-p regexp (car
xs)))
- xs
- (zz-regexp-car-member regexp (cdr xs)))))
-
+(defalias 'zz-add-zone-and-coalesce #'zz-add-zone-and-unite)
;;;###autoload
-(defun zz-add-zone (start end &optional variable not-buf-local-p set-var-p
msg) ; Bound to `C-x n a'.
- "Add an izone for the text from START to END to the izones of VARIABLE.
+(defun zz-add-zone-and-unite (start end &optional variable msg) ; Bound to
`C-x n A'.
+ "Add an izone from START to END to those of VARIABLE, and coalesce.
+Use `zz-add-zone', then apply `zz-unite-zones'.
+United zones are in ascending order of their cars.
Return the new value of VARIABLE.
This is a destructive operation: The list structure of the variable
@@ -1445,866 +1428,875 @@ VARIABLE defaults to the value of `zz-izones-var'.
START and END are as for `narrow-to-region'.
With a prefix arg you are prompted for a different variable to use, in
-place of the current value of `zz-izones-var'. The particular prefix
-arg determines whether the variable, if unbound, is made buffer-local,
-and whether `zz-izones-var' is set to the variable symbol:
-
- prefix arg buffer-local set `zz-izones-var'
- ---------- ------------ -------------------
- Plain `C-u' yes yes
- > 0 (e.g. `C-1') yes no
- = 0 (e.g. `C-0') no yes
- < 0 (e.g. `C--') no no
+place of the current value of `zz-izones-var'. If the prefix arg is
+non-negative (>= 0) then make the variable buffer-local. If the
+prefix arg is non-positive (<= 0) then set `zz-izones-var' to that
+variable symbol. (Zero: do both.)
Non-interactively:
* VARIABLE is the optional izones variable to use.
-* Non-nil NOT-BUF-LOCAL-P means do not make VARIABLE buffer-local.
-* Non-nil SET-VAR-P means set `zz-izones-var' to VARIABLE.
-* Non-nil MSG means echo the zone limits, preceded by string MSG."
- (interactive (let* ((beg (region-beginning))
- (end (region-end))
- (var (or (and current-prefix-arg
(zz-read-any-variable "Variable: " zz-izones-var))
- zz-izones-var))
- (npref (prefix-numeric-value current-prefix-arg))
- (nloc (and current-prefix-arg (<= npref 0) (not
(boundp var))))
- (setv (and current-prefix-arg (or (consp
current-prefix-arg) (= npref 0)))))
- (list beg end var nloc setv "Recorded zone: ")))
- (let* ((mrk1 (make-marker))
- (mrk2 (make-marker))
- (var (or variable zz-izones-var))
- (_IGNORE (unless (or not-buf-local-p (boundp var))
(make-local-variable var)))
- (_IGNORE (when set-var-p (setq zz-izones-var var)))
- (_IGNORE (unless (boundp var) (set var ())))
- (val (symbol-value var))
- sans-id id-cons id)
- (unless (zz-izones-p val) (error "Not an izones variable: `%s', value:
`%S'" var val))
- (move-marker mrk1 start)
- (move-marker mrk2 end)
- (setq sans-id (list mrk1 mrk2)
- id-cons (rassoc sans-id val)
- id (if id-cons (car id-cons) (- (1+ (length val)))) ; 1-based,
not 0-based.
- val (set var (zz-rassoc-delete-all sans-id val))) ; Destructive
operation.
- (unless (and (= mrk1 1) (= mrk2 (1+ (buffer-size)))) (set var `((,id
,mrk1 ,mrk2) ,@val)))
- (when msg (message "%s%d to %d" msg (marker-position mrk1)
(marker-position mrk2)))
- (symbol-value var)))
+* Non-nil MSG means echo messages for adding the zone and uniting
+ zones. In this case MSG is the message prefix for `zz-add-zone'."
+ (interactive (let ((beg (region-beginning))
+ (end (region-end))
+ (var (or (and current-prefix-arg
(zz-read-any-variable "Variable: " zz-izones-var))
+ zz-izones-var))
+ (npref (prefix-numeric-value current-prefix-arg)))
+ (when (and current-prefix-arg (>= npref 0))
(make-local-variable var))
+ (when (and current-prefix-arg (<= npref 0)) (setq
zz-izones-var var))
+ (list beg end var "Zone recorded: ")))
+ (unless variable (setq variable zz-izones-var))
+ (zz-add-zone start end variable nil nil msg)
+ (zz-unite-zones variable msg)
+ (symbol-value variable))
;;;###autoload
-(defun zz-delete-zone (id &optional variable msgp) ; Bound to `C-x n C-d'.
- "Delete a zone by completing against its ID and its text (content).
-Delete the zone from VARIABLE, and renumber those remaining.
+(defun zz-add-zones-matching-regexp (regexp ; Bound to `C-x n r'
+ &optional variable beg end
not-buf-local-p set-var-p msgp)
+ "Add matches for REGEXP as zones to the izones of VARIABLE.
+If region is active, limit action to region. Else, use whole buffer.
Return the new value of VARIABLE.
-This is a destructive operation: The list structure of the variable
-value can be modified.
-
-VARIABLE defaults to the value of `zz-izones-var'. With a prefix arg
-you are prompted for a different variable to use.
+If `isearchp-dim-outside-search-area-flag' is non-nil then dim the
+non-contexts. (You can use `\\[isearchp-remove-dimming]' or \
+`\\[isearchp-toggle-dimming-outside-search-area]' to remove the
+dimming.)
-Non-nil optional arg NOMSG means do not display a status message."
+See `zz-add-zone' for a description of VARIABLE, the use of a prefix
+arg, and the parameters when called from Lisp."
(interactive
- (let* ((var (or (and current-prefix-arg (zz-read-any-variable
"Variable: " zz-izones-var t))
- zz-izones-var))
- (izones (symbol-value var))
- (_IGNORE (unless (zz-izones-p izones)
- (error "Not an izones variable: `%s', value: `%S'" var
izones)))
- (_IGNORE (unless izones (error "No zones - variable `%s' is empty"
var)))
- (len (length izones))
- (num (if (= len 1)
- 1
- (string-to-number (completing-read (format "Delete zone
with ID (1 to %d): " len)
- (mapcar
zz-zone-abstract-function izones) nil t)))))
- (list num var t)))
- (unless variable (setq variable zz-izones-var))
- (let ((izones (symbol-value variable)))
- (unless (zz-izones-p izones) (error "Not an izones variable: `%s', value:
`%S'" variable izones))
- (unless izones (error "No zones - variable `%s' is empty" variable))
- (set variable (assq-delete-all (- id) izones)))
- (zz-izones-renumber variable)
- (when msgp (message "Deleted zone with ID %d" id))
- (symbol-value variable))
-
-(defun zz-markerize (izone)
- "Convert IZONE to use markers.
-IZONE is a list of an identifier (a number) and two buffer
-positions (numbers, markers, or readable-marker objects). Positions
-that are numbers or readable-marker objects are converted to markers.
-
-This is a non-destructive operation: it returns a new list."
- (let ((ii 1)
- posn)
- (while (< ii 3)
- (setq posn (nth ii izone))
- (when (and (not (markerp posn)) (or (natnump posn)
(zz-readable-marker-p posn)))
- (setcar (nthcdr ii izone) (zz-marker-from-object posn)))
- (setq ii (1+ ii))))
- izone)
-
-(defun zz-marker-from-object (object)
- "Return an equivalent marker for OBJECT.
-This is a non-destructive operation: OBJECT is not modified.
-
-If OBJECT is a marker then return it.
-If it is a number then return (copy-marker OBJECT).
-If it is a readable-marker sexp then return an equivalent real marker.
-Otherwise, return nil.
-
-A readable marker is a sexp of form (marker BUFFER POSITION), where
-BUFFER is a buffer name (string) and POSITION is a buffer position
-\(number)."
- (cond ((markerp object) object)
- ((numberp object) (copy-marker object))
- ((zz-readable-marker-p object)
- (with-current-buffer (get-buffer-create (nth 1 object)) (copy-marker
(nth 2 object))))
- (t nil)))
-
-(defun zz-number-or-marker-p (position)
- "Return non-nil if POSITION is a number, marker, or readable-marker object."
- ;; Just like `number-or-marker-p', We don't check that a number arg is a
positive integer.
- (or (number-or-marker-p position) (zz-readable-marker-p position)))
-
-(defun zz-readable-marker-p (object)
- "Return non-nil if OBJECT is a readable marker.
-That is, it has form (marker BUFFER POSITION), where BUFFER is a
-buffer name (string), and POSITION is a buffer position (integer).
-OBJECT is returned."
- (and (consp object) (consp (cdr object)) (consp (cddr object))
- (eq 'marker (nth 0 object)) (stringp (nth 1 object)) (integerp (nth 2
object))
- object))
-
-(defun zz-readable-marker (number-or-marker &optional num-buffer)
- "Return a readable marker equivalent to NUMBER-OR-MARKER, or nil.
-Return nil if NUMBER-OR-MARKER is not `number-or-marker-p'.
-\(If NUMBER-OR-MARKER is already a readable marker then return it.)
-
-A readable marker satisfies `zz-readable-marker-p'. It has the form
-\(marker BUFFER POSITION), where BUFFER is a buffer name (string) and
-POSITION is a buffer position (number).
-
-If NUMBER-OR-MARKER is itself a readable marker then return it.
-
-If NUMBER-OR-MARKER is a marker then use its buffer name as BUFFER.
+ (let* ((regx (read-regexp "Add zones matching regexp: "))
+ (var (or (and current-prefix-arg (zz-read-any-variable
"Variable: " zz-izones-var t))
+ zz-izones-var))
+ (beg (if (and transient-mark-mode mark-active)
(region-beginning) (point-min)))
+ (end (if (and transient-mark-mode mark-active) (region-end)
(point-max)))
+ (npref (prefix-numeric-value current-prefix-arg))
+ (nloc (and current-prefix-arg (<= npref 0) (not (boundp var))))
+ (setv (and current-prefix-arg (or (consp current-prefix-arg) (=
npref 0)))))
+ (list regx var beg end nloc setv t)))
+ (unless (and beg end) (setq beg (point-min)
+ end (point-max)))
+ (unless (< beg end) (setq beg (prog1 end (setq end beg))))
+ (let ((last-beg nil)
+ (num-hits 0))
+ (condition-case-unless-debug zz-add-zones-matching-regexp
+ (save-excursion
+ (goto-char (setq last-beg beg))
+ (while (and beg (< beg end) (not (eobp))
+ (progn (while (and (setq beg (re-search-forward regexp
end t))
+ (eq last-beg beg)
+ (not (eobp)))
+ ;; Matched again, same place. Advance 1 char.
+ (forward-char) (setq beg (1+ beg)))
+ beg)) ; Stop if no more matches.
+ (setq num-hits (1+ num-hits))
+ (let* ((hit-beg (match-beginning 0))
+ (hit-end (match-end 0))
+ (hit-string (buffer-substring-no-properties hit-beg
hit-end))
+ (c-beg last-beg)
+ (c-end (if beg (match-beginning 0) (min end
(point-max)))) ; Truncate.
+ )
+ (isearchp-add/remove-dim-overlay c-beg c-end 'ADD)
+ (cond ((not (string= "" hit-string))
+ (zz-add-zone c-beg c-end variable not-buf-local-p
set-var-p)
+ (isearchp-add/remove-dim-overlay hit-beg hit-end nil))
+ (t
+ (isearchp-add/remove-dim-overlay hit-beg hit-end 'ADD))))
+ (goto-char (setq last-beg beg))))
+ (error (error "%s" (error-message-string zz-add-zones-matching-regexp))))
+ (unless (> num-hits 0) (zz-user-error "No regexp matches"))
+ (when msgp
+ (let ((dim-msg (if (not (bound-and-true-p
isearchp-dim-outside-search-area-flag))
+ ""
+ (substitute-command-keys
+ "; `\\[isearchp-remove-dimming]' or \
+`\\[isearchp-toggle-dimming-outside-search-area]' removes dimming"))))
+ (case num-hits
+ (1 (message "1 zone added%s" dim-msg))
+ (t (message "%d zones added or updated%s" num-hits dim-msg)))))
+ variable))
-If NUMBER-OR-MARKER is a number then:
- If NUM-BUFFER names an existing buffer then use it as BUFFER.
- Else use the name of the current buffer as BUFFER.
+;;;###autoload
+(defun zz-set-zones-matching-regexp (regexp ; Bound to `C-x n R'
+ &optional variable beg end
not-buf-local-p set-var-p msgp)
+ "Replace value of izones variable with zones matching REGEXP.
+Like `zz-add-zones-matching-regexp' (which see), but it replaces any
+current zones instead of adding to them."
+ (interactive
+ (let* ((var (or (and current-prefix-arg (zz-read-any-variable
"Variable: " zz-izones-var t))
+ zz-izones-var))
+ (regx (read-regexp (format "Set `%s' to zones matching regexp: "
var)))
+ (beg (if (and transient-mark-mode mark-active)
(region-beginning) (point-min)))
+ (end (if (and transient-mark-mode mark-active) (region-end)
(point-max)))
+ (npref (prefix-numeric-value current-prefix-arg))
+ (nloc (and current-prefix-arg (<= npref 0) (not (boundp var))))
+ (setv (and current-prefix-arg (or (consp current-prefix-arg) (=
npref 0)))))
+ (list regx var beg end nloc setv t)))
+ (set variable ())
+ (zz-add-zones-matching-regexp regexp variable beg end not-buf-local-p
set-var-p msgp))
-This is a non-destructive operation."
- ;; Just like `number-or-marker-p', We don't check that a number arg is a
positive integer.
- (cond ((zz-readable-marker-p number-or-marker) number-or-marker)
- ((markerp number-or-marker)
- `(marker ,(buffer-name (marker-buffer number-or-marker))
,(marker-position number-or-marker)))
- ((numberp number-or-marker)
- `(marker
- ,(buffer-name (or (and (stringp num-buffer) (get-buffer
num-buffer)) (current-buffer)))
- ,number-or-marker))
- (t nil)))
+;;;###autoload
+(defun zz-add-zones-from-highlighting ( ; Bound to `C-x n l'
+ &optional start end face only-hlt-face
overlay/text fonk-lock-p msgp)
+ "Add highlighted areas as zones to izones variable.
+By default, the text used is that highlighted with `hlt-last-face'.
+With a non-negative prefix arg you are instead prompted for the face.
-(defun zz-izones-p (value)
- "Return non-nil if VALUE is a (possibly empty) list of izones.
-That is, non-nil means that VALUE has the form of `zz-izones'."
- (and (listp value) (listp (cdr (last value))) ; Proper list.
- (let ((res t))
- (catch 'zz-izones-p
- (dolist (xx value)
- (unless (setq res (zz-izone-p xx)) (throw 'zz-izones-p nil))))
- res)))
+With a non-positive prefix arg use face property `font-lock-face'
+instead of property `face'.
-(defun zz-izone-p (value)
- "Return non-nil if VALUE is an izone.
-That is, non-nil means it has the form (ID POS1 POS2 . EXTRA),
-where ID is a negative integer, and each POS<N> is a buffer-position
-representation (`zz-number-or-marker-p')."
- (and (consp value) (condition-case nil
- (and (integerp (nth 0 value))
- (< (nth 0 value) 0)
- (zz-number-or-marker-p (nth 1 value))
- (zz-number-or-marker-p (nth 2 value)))
- (error nil))))
+The izones variable to use is the value of `zz-izones-var'. You can
+set this to a different variable anytime using `\\[zz-set-izones-var]'.
-(defun zz-rassoc-delete-all (value alist)
- "Delete from ALIST all elements whose cdr is `equal' to VALUE.
-Elements of ALIST that are not conses are ignored.
-Return the modified alist.
-This is a destructive operation."
- (while (and (consp (car alist)) (equal (cdar alist) value)) (setq alist
(cdr alist)))
- (let ((tail alist)
- tail-cdr)
- (while (setq tail-cdr (cdr tail))
- (if (and (consp (car tail-cdr)) (equal (cdar tail-cdr) value))
- (setcdr tail (cdr tail-cdr))
- (setq tail tail-cdr))))
- alist)
+All highlighting is checked, both overlays and face text properties.
+The number of highlighted areas added as zones is echoed in a message.
+This might be less than the number of zones added, because there can
+be multiple highlights with the same face for the same area.
-(defun zz-izones-renumber (&optional variable)
- "Renumber the izones of this buffer in the current `zz-izones-var'.
-This is a destructive operation: The list structure of the variable
-value can be modified."
- (let* ((var (or variable zz-izones-var))
- (orig (symbol-value var)))
- (set var ())
- (dolist (iz orig) (zz-add-zone (cadr iz) (car (cddr iz)) var))))
+When called from Lisp:
-;; Non-destructive version.
-;;
-;; (defun zz-izone-limits-in-bufs (buffers &optional variable)
-;; "Return a list of all `zz-izone-limits' for each buffer in BUFFERS.
-;; That is, return a list of all recorded buffer zones for BUFFERS.
-;; If BUFFERS is nil, return the zones recorded for the current buffer.
-;;
-;; This is a non-destructive operation: The list returned is independent
-;; of the `zz-izone-limits' list in each of the buffers.
-;;
-;; Optional arg VARIABLE is the izones variable to use. If nil,
-;; use the value of `zz-izones-var'. The variable is evaluated in each
-;; buffer (or in the current buffer, if BUFFERS is nil)."
-;;
-;; (let ((limits ()))
-;; (dolist (buf (or (reverse buffers) (list (current-buffer)))) ;
Reverse so we keep the order.
-;; (with-current-buffer buf
-;; (setq limits (append (zz-izone-limits (symbol-value (or variable
zz-izones-var))
-;; buf
-;; 'ONLY-THIS-BUFFER)
-;; limits))))
-;; limits))
+* Non-nil START and END are the buffer limits to search.
+* Non-nil FACE is the highlighting face to look for.
+* Non-nil ONLY-HLT-FACE means check only `highlight.el' highlighting.
+ (By default, any highlighting is checked.)
+* If OVERLAY/TEXT is `text-prop' then only text-property highlighting
+ is checked. If it is `overlay' then only overlay highlighting is
+ checked. (If nil then both are checked.)
+* Non-nil FONK-LOCK-P means check property `font-lock-face'. By
+ default (nil), check property `face'."
+ (interactive
+ (let ((numarg (and current-prefix-arg (prefix-numeric-value
current-prefix-arg))))
+ (unless (require 'highlight nil t) (zz-user-error "You need library
`highlight.el' to use this command"))
+ `(,@(hlt-region-or-buffer-limits)
+ ,(if (natnump numarg)
+ (hlt-read-bg/face-name "Create zones highlighted with face: ")
+ hlt-last-face)
+ nil nil ,(and numarg (<= numarg 0)) t)))
+ (require 'highlight)
+ (unless (and start end) (let ((start-end (hlt-region-or-buffer-limits)))
+ (setq start (car start-end)
+ end (cadr start-end))))
+ (unless face (setq face hlt-last-face))
+ (let ((hlt-use-overlays-flag (case overlay/text
+ (text-prop nil) ; Only text property
+ (overlay 'only) ; Only overlay
+ (t t))) ; Default: both
+ (hlt-act-on-any-face-flag (not only-hlt-face))
+ (hlt-face-prop (if fonk-lock-p 'font-lock-face 'face))
+ (count 0))
+ (save-excursion
+ (save-window-excursion
+ (goto-char start)
+ (let ((zone-beg start)
+ zone-end zone)
+ (while (and zone-beg (< zone-beg end))
+ (setq zone (hlt-next-highlight zone-beg end face nil nil
'no-error-msg)
+ zone-beg (car zone)
+ zone-end (cdr zone))
+ ;; Create zone from `zone-beg' to `zone-end' if highlighted. Add
it to zones list.
+ (when hlt-use-overlays-flag
+ (let ((overlays (overlays-at zone-beg)))
+ (while overlays
+ (when (and (or hlt-act-on-any-face-flag
+ (equal face (overlay-get (car overlays)
'hlt-highlight)))
+ (equal face (overlay-get (car overlays)
hlt-face-prop)))
+ (zz-add-zone zone-beg zone-end)
+ (setq count (1+ count)))
+ (when overlays (setq overlays (cdr overlays))))))
+ (when (and (not (eq hlt-use-overlays-flag 'only))
+ (or hlt-act-on-any-face-flag (equal face
(get-text-property (point) 'hlt-highlight)))
+ (let ((pt-faces (get-text-property (point)
hlt-face-prop)))
+ (if (consp pt-faces) (memq face pt-faces) (equal face
pt-faces))))
+ (zz-add-zone zone-beg zone-end)
+ (setq count (1+ count)))))))
+ (when msgp
+ (case count
+ (0 (message "NO zones added or updated"))
+ (1 (message "1 zone added or updated"))
+ (t (message "%s highlighted areas added or updated as zones"
count))))))
-(defun zz-izone-limits-in-bufs (buffers &optional variable)
- "Return a list of all `zz-izone-limits' for each buffer in BUFFERS.
-That is, return a list of all recorded buffer zones for BUFFERS.
-If BUFFERS is nil, return the zones recorded for the current buffer.
+;;;###autoload
+(defun zz-set-zones-from-highlighting ( ; Bound to `C-x n L'
+ &optional start end face only-hlt-face
overlay/text fonk-lock-p msgp)
+ "Replace value of izones variable with zones from the highlighted areas.
+Like `zz-add-zones-from-highlighting' (which see), but it replaces any
+current zones instead of adding to them."
+ (interactive
+ (let ((numarg (and current-prefix-arg (prefix-numeric-value
current-prefix-arg))))
+ (unless (require 'highlight nil t) (zz-user-error "You need library
`highlight.el' to use this command"))
+ `(,@(hlt-region-or-buffer-limits)
+ ,(if (natnump numarg)
+ (hlt-read-bg/face-name "Create zones highlighted with face: ")
+ hlt-last-face)
+ nil nil ,(and numarg (<= numarg 0)) t)))
+ (set zz-izones-var ())
+ (zz-add-zones-from-highlighting start end face only-hlt-face overlay/text
fonk-lock-p msgp))
-This is a destructive operation: The list returned can have as
-sublists the `zz-izone-limits' lists of BUFFERS.
+;;;###autoload
+(defun zz-set-zones-from-face (face &optional start end variable) ; Bound to
`C-x n f'
+ "Set an izones variable to (united) zones of a face or background color.
+You are prompted for a face name or a color name. If you enter a
+color, it is used for the face background. The face foreground is
+determined by the value of `hlt-auto-face-foreground'.
+The variable defaults to `zz-izones'. With a prefix arg you are
+ prompted for a different izones variable."
+ (interactive
+ (progn
+ (unless (require 'highlight nil t)
+ (error "You need library `highlight.el' for this command"))
+ (let ((fac (hlt-read-bg/face-name "Choose background color or face: "
+ (and (symbolp hlt-last-face)
(symbol-name hlt-last-face))))
+ (var (or (and current-prefix-arg (zz-read-any-variable "Variable:
" zz-izones-var))
+ zz-izones-var)))
+ (if (hlt-nonempty-region-p)
+ (if (< (point) (mark)) (list (point) (mark) var t) (list (mark)
(point) var t))
+ (list fac (point-min) (point-max) var t)))))
+ (unless (require 'highlight nil t)
+ (error "You need library `highlight.el' for this command"))
+ (unless (require 'isearch-prop nil t)
+ (error "You need library `isearch-prop.el' for this command"))
+ (unless (require 'zones nil t)
+ (error "You need library `zones' for this command"))
+ (font-lock-default-fontify-buffer) ; Fontify the whole buffer.
+ (zz-set-zones-from-highlighting start end face nil 'text-prop)
+ (zz-unite-zones variable t))
+
+;;(@* "General Non-Interactive Functions")
-Optional arg VARIABLE is the izones variable to use. If nil, use the
-value of `zz-izones-var'. The variable is evaluated in each
-buffer (or in the current buffer, if BUFFERS is nil)."
- (let ((limits ()))
- (dolist (buf (or buffers (list (current-buffer))))
- (with-current-buffer buf
- (setq limits (nconc limits
- (zz-izone-limits (symbol-value (or variable
zz-izones-var)) buf 'THISBUF)))))
- limits))
+;;; General Non-Interactive Functions --------------------------------
-(defun zz-izone-limits (&optional izones buffer only-one-buffer-p)
- "Return a list like IZONES, but with no identifiers.
-That is, return a list of zones, (LIMIT1 LIMIT2 . EXTRA).
+(defun zz-zone-abstract-function-default (izone)
+ "Default value of `zz-zone-abstract-function'.
+The abstract it produces for IZONE is (the absolute value of) the zone
+ID, followed by the first `zz-zone-abstract-limit' chars of the zone
+text. The return value of the function is a cons, (ABSTRACT . IZONE),
+whose car is the abstract and whose cdr is the izone."
+ (let ((id (abs (car izone)))
+ (beg (cadr izone))
+ (end (caddr izone)))
+ (cons (format "%d %s" id (buffer-substring beg (min (+ beg
zz-zone-abstract-limit) end))) izone)))
-This is a non-destructive operation: A new list is returned.
+(defun zz-zone-ordered (zone)
+ "Return ZONE or ZONE with its car and cadr reversed, so car <= cadr.
+The cddr of ZONE remains as it was."
+ (let ((beg (car zone))
+ (end (cadr zone))
+ (extra (cddr zone)))
+ (when (zz-readable-marker-p beg) (setq beg (nth 2 beg)))
+ (when (zz-readable-marker-p end) (setq end (nth 2 end)))
+ (if (<= beg end) zone `(,end ,beg ,@extra))))
-Each limit can be a number or a marker (but see ONLY-ONE-BUFFER-P).
-The conses are new - they do not share with any conses with IZONES.
+(defun zz-zones-overlap-p (zone1 zone2)
+ "Return non-nil if ZONE1 and ZONE2 overlap.
+Assumes that each zone is ordered (its car <= its cadr).
+The cddrs are ignored.
-Optional input list IZONES has the same structure as `zz-izones'. If
-IZONES is nil then the variable that is the value of `zz-izones-var'
-is used. It is evaluated in BUFFER (default: current buffer) to
-obtain the izones.
+Zones that use markers do not overlap if the marker buffers differ."
+ (and (zz-zones-same-buffer-name-p zone1 zone2)
+ (progn (when (< (car zone2) (car zone1)) (setq zone1 (prog1 zone2 (setq
zone2 zone1))))
+ (<= (car zone2) (cadr zone1)))))
-Non-nil optional arg ONLY-ONE-BUFFER-P means remove any izones that
-contain markers for a buffer other than BUFFER."
- (unless buffer (setq buffer (current-buffer)))
- (let ((restrs (or izones (with-current-buffer buffer (symbol-value
zz-izones-var)))))
- (when only-one-buffer-p (setq restrs
(zz-remove-izones-w-other-buffer-markers restrs)))
- (delq nil (mapcar #'cdr restrs))))
+(defun zz-zones-same-buffer-name-p (zone1 zone2)
+ "Return non-nil if ZONE1 and ZONE2 apply to the same buffer.
+This is the case if `zz-zone-buffer-name' returns the same name for
+each. (A buffer with that name need not exist.)"
+ (eq (zz-zone-buffer-name zone1) (zz-zone-buffer-name zone2)))
-;; Useful for commands that want to act on zones in multiple buffers.
-(defun zz-read-bufs ()
- "Read names of buffers, one at a time. `C-g' ends reading."
- (let ((bufs ())
- buf)
- (while (condition-case nil
- (setq buf (read-buffer "Buffer (C-g to end): "
- (and (not (member (buffer-name
(current-buffer)) bufs))
- (current-buffer))
- t))
- (quit nil))
- (push buf bufs))
- (delq nil (mapcar #'get-buffer (nreverse bufs)))))
+(defun zz-zone-buffer-name (zone)
+ "Return the name of the buffer used by ZONE.
+If the two ZONE positions specify different buffers, or if either is a
+marker that points nowhere, then raise an error."
+ (let* ((lim1 (car zone))
+ (lim2 (cadr zone))
+ (buf1 (cond ((markerp lim1) (and (marker-buffer lim1)
+ (buffer-name
(marker-buffer lim1))))
+ ((zz-readable-marker-p lim1) (cadr lim1))
+ (t (buffer-name
(current-buffer)))))
+ (buf2 (cond ((markerp lim2) (and (marker-buffer lim2)
+ (buffer-name
(marker-buffer lim2))))
+ ((zz-readable-marker-p lim2) (cadr lim2))
+ (t (buffer-name
(current-buffer))))))
+ (unless (and buf1 buf2) (error "Zone has marker(s) that point nowhere:
%S" zone))
+ (unless (equal buf1 buf2) (error "Zone has conflicting buffers: %S" zone))
+ buf1))
-(defun zz-remove-zones-w-other-buffer-markers (zones &optional buffer)
- "Return ZONES, but remove any that use markers for another buffer.
-BUFFER is the buffer to compare with (default: current buffer).
-This is a non-destructive operation: a (shallow) copy is returned."
- (unless buffer (setq buffer (current-buffer)))
- (zz-remove-if `(lambda (zone) (zz-zone-has-other-buffer-marker-p zone
',buffer)) zones))
+(defun zz-choose-zone-by-id-and-text (&optional izones)
+ "Prompt for a zone from IZONES, completing against its ID and its text.
+Return the chosen zone. If you hit `RET' with empty input then this
+is the first zone of IZONES.
+
+IZONES defaults to the value of the variable that is the value of
+`zz-izones-var'."
+ (setq izones (or izones (symbol-value zz-izones-var)))
+ (unless izones (zz-user-error "No zones defined"))
+ (let* ((abs-zones (mapcar zz-zone-abstract-function izones))
+ (num (string-to-number
+ (completing-read "Zone: "
+ abs-zones nil t nil 'zz-zone-history
(car abs-zones)))))
+ (assq (- num) izones)))
+
+(defun zz-do-zones (function &optional zones unite-p)
+ "Like `zz-map-zones', but without returning the result of mapping.
+The return value is undefined."
+ (when (functionp function)
+ (when (zz-izones-p zones) (setq zones (zz-izone-limits zones nil
'ONLY-THIS-BUFFER)))
+ (when unite-p (setq zones (zz-zone-union zones)))
+ (dolist (zone zones) (funcall function (car zone) (cadr zone)))))
-(defun zz-remove-izones-w-other-buffer-markers (izones &optional buffer)
- "Return IZONES, but remove any that use markers for another buffer.
-BUFFER is the buffer to compare with (default: current buffer).
-This is a non-destructive operation: a (shallow) copy is returned."
- (unless buffer (setq buffer (current-buffer)))
- (zz-remove-if `(lambda (izone) (zz-izone-has-other-buffer-marker-p izone
',buffer)) izones))
+(defun zz-map-zones (function &optional zones unite-p)
+ "Map binary FUNCTION over ZONES, applying it to the limits of each zone.
+ZONES can be a list of basic zones or a list like `zz-izones', that
+is, zones that have identifiers.
+Non-nil optional arg UNITE-P means first unite the zones and then
+iterate over the resulting list."
+ (if (not (functionp function))
+ (or zones zz-izones)
+ (when (zz-izones-p zones) (setq zones (zz-izone-limits zones nil
'ONLY-THIS-BUFFER)))
+ (when unite-p (setq zones (zz-zone-union zones)))
+ (mapcar (lambda (zone) (funcall function (car zone) (cadr zone))) zones)))
-(defun zz-zone-has-other-buffer-marker-p (zone &optional buffer)
- "Return non-nil if basic ZONE has a marker for another buffer.
-The first marker in the zone is returned.
-BUFFER is the buffer to compare with (default: current buffer)."
- (unless buffer (setq buffer (current-buffer)))
- (let ((m1 (nth 0 zone))
- (m2 (nth 1 zone)))
- (or (and (markerp m1) (not (eq buffer (marker-buffer m1))) m1)
- (and (markerp m2) (not (eq buffer (marker-buffer m2))) m2))))
+(defun zz-do-izones (function &optional izones unite-p)
+ "Like `zz-map-izones', but without returning the result of mapping.
+The return value is undefined."
+ (when (functionp function)
+ (when unite-p (setq izones (zz-unite-zones izones)))
+ (dolist (izone izones) (funcall function (car izone) (cadr izone) (caddr
izone)))))
-(defun zz-izone-has-other-buffer-marker-p (izone &optional buffer)
- "Return non-nil if IZONE has a marker for another buffer.
-The first marker in the izone is returned.
-BUFFER is the buffer to compare with (default: current buffer)."
- (unless buffer (setq buffer (current-buffer)))
- (let ((m1 (nth 1 izone))
- (m2 (nth 2 izone)))
- (or (and (markerp m1) (not (eq buffer (marker-buffer m1))) m1)
- (and (markerp m2) (not (eq buffer (marker-buffer m2))) m2))))
+(defun zz-map-izones (function &optional izones unite-p)
+ "Map FUNCTION over IZONES.
+Apply FUNCTION to the first three elements of each izone, that is, the
+ identifier and the zone limits.
+IZONES is a list like `zz-izones', that is, zones with identifiers.
+By default, IZONES is the value of `zz-izones'.
+Non-nil optional arg UNITE-P means first unite the zones and then
+iterate over the resulting list."
+ (if (not (functionp function))
+ (or izones zz-izones)
+ (when unite-p (setq izones (zz-unite-zones izones)))
+ (mapcar (lambda (izone) (funcall function (car izone) (cadr izone) (caddr
izone))) izones)))
-(defun zz-remove-if (pred xs)
- "A copy of list XS with no elements that satisfy predicate PRED."
- (let ((result ()))
- (dolist (x xs) (unless (funcall pred x) (push x result)))
- (nreverse result)))
+(defun zz-order-zones (&optional zones _descendingp)
+ "Order each zone in ZONES, so that first limit is less than the second.
+ZONES can be a list of basic zones or a list like `zz-izones', that
+is, zones that have identifiers.
+Non-nil optional arg DESCENDINGP means put greater limit first."
+ (zz-map-zones (lambda (lim1 lim2) (if (> lim1 lim2) (list lim2 lim1) (list
lim1 lim2))) zones))
-;; Useful for commands that want to act on zones in multiple buffers (e.g.,
visible buffers only).
-;;
-;; Same as `icicle-remove-if-not' etc.
-(defun zz-remove-if-not (pred xs)
- "A copy of list XS with only elements that satisfy predicate PRED."
- (let ((result ()))
- (dolist (x xs) (when (funcall pred x) (push x result)))
- (nreverse result)))
+(defun zz-zones-complement (zones &optional beg end)
+ "Return a list of zones that is the complement of ZONES, from BEG to END.
+ZONES is assumed to be a union, i.e., sorted by car, with no overlaps.
+Any extra info in a zone of ZONES, i.e., after the cadr, is ignored."
+ (setq beg (zz-marker-from-object (or beg (point-min)))
+ end (zz-marker-from-object (or end (point-max))))
+ (let ((res ()))
+ (dolist (zone zones)
+ (push (list beg (car zone)) res)
+ (setq beg (cadr zone)))
+ (setq res (nreverse (push (list beg end) res)))))
-;; Like `read-any-variable' in `strings.el', but passes REQUIRE-MATCH arg to
`completing-read'.
-(defun zz-read-any-variable (prompt &optional default-value require-match)
- "Read the name of a variable and return it as a symbol.
-Prompts with string PROMPT. By default, returns DEFAULT-VALUE if
-non-nil. If DEFAULT-VALUE is nil and the nearest symbol to the cursor
-is a variable, then return that by default.
+(defun zz-two-zone-union (zone1 zone2)
+ "Return the union of ZONE1 and ZONE2, or nil if they do not overlap.
+Assumes that each zone is ordered (its car <= its cadr).
-Unlike `read-variable', which reads only user options, this reads the
-name of any variable. If optional arg REQUIRE-MATCH is nil then it
-reads any symbol, but it provides completion against variable names."
- (let ((symb (cond ((fboundp 'symbol-nearest-point)
(symbol-nearest-point))
- ((fboundp 'symbol-at-point)
(symbol-at-point))
- (t nil)))
- (enable-recursive-minibuffers t))
- (when (and default-value (symbolp default-value))
- (setq default-value (symbol-name default-value)))
- (intern (completing-read prompt obarray 'boundp require-match nil
'minibuffer-history
- (let ((var-at-pt (and symb (boundp symb)
(symbol-name symb))))
- (if (and default-value var-at-pt (>
emacs-major-version 22))
- (list default-value var-at-pt)
- (or default-value var-at-pt)))
- t))))
+The cddr of a non-nil result (its EXTRA information, which must be a
+list) is the union of the EXTRA information of each zone:
-(defalias 'zz-buffer-narrowed-p
- (if (fboundp 'buffer-narrowed-p)
- #'buffer-narrowed-p ; Emacs 24+
- (lambda () (/= (- (point-max) (point-min)) (buffer-size)))))
+ (zz-set-union (cddr zone1) (cddr zone2))
-(defalias 'zz-string-match-p
- (if (fboundp 'string-match-p)
- #'string-match-p ; Emacs 23+
- (lambda (regexp string &optional start)
- "Like `string-match', but this saves and restores the match data."
- (save-match-data (string-match regexp string start)))))
+This is a non-destructive operation: The result is a new list."
+ (and (zz-zones-overlap-p zone1 zone2) `(,(zz-min (car zone1) (car zone2))
+ ,(zz-max (cadr zone1) (cadr zone2))
+ ,@(zz-set-union (cddr zone1) (cddr
zone2)))))
-(defun zz-repeat-command (command)
- "Repeat COMMAND."
- (require 'repeat) ;Define its vars before we let-bind them!
- (let ((repeat-previous-repeated-command command)
- (repeat-message-function #'ignore)
- (last-repeatable-command 'repeat))
- (repeat nil)))
+(defun zz-zone-union (zones &optional buffer)
+ "Return the union (coalescence) of the zones in list ZONES.
+Each element of ZONES is a list of two zone limits, possibly followed
+by extra info: (LIMIT1 LIMIT2 . EXTRA), where EXTRA is a list.
+The limits need not be in numerical order.
-;;;###autoload
-(defun zz-narrow-repeat () ; Bound to `C-x n x'.
- "Cycle to the next buffer restriction (narrowing).
-This is a repeatable version of `zz-narrow'.
+Each limit can be a number or a marker, but zones with markers for
+buffers other than BUFFER (default: current buffer) are ignored.
-Note that if the value of `zz-izones-var' is not buffer-local then you
-can use this command to cycle among zones in multiple buffers."
- (interactive)
- (zz-repeat-command 'zz-narrow))
+Any zones that use markers for a buffer other than BUFFER (default:
+current buffer) are excluded.
-;;;###autoload
-(defalias 'zz-select-region-repeat #'zz-select-zone-repeat)
-;;;###autoload
-(defun zz-select-zone-repeat () ; Bound to `C-x n C-x'.
- "Cycle to the next zone, and make it the active region.
-Zones are cycled in chronological order of their recording.
-This is a repeatable version of `zz-select-zone'."
- (interactive)
- (zz-repeat-command 'zz-select-zone))
+Returns a new list, which is sorted by the lower limit of each zone,
+which is its car. (This is a non-destructive operation.)
-(defun zz-izones-from-zones (basic-zones)
- "Return a list of zones like `zz-izones', based on BASIC-ZONES.
-Each zone in the list BASIC-ZONES has form (LIMIT1 LIMIT2 . EXTRA),
-where each of the limits is a buffer position (a number or marker) and
-EXTRA is a list.
+Each zone in ZONES is first ordered, so that its car <= its cadr.
+The resulting zones are then sorted by their cars.
-This is a non-destructive operation. A new list is returned.
+`zz-two-zone-union' is then applied recursively to coalesce
+overlapping or adjacent zones. This means also that any EXTRA info is
+combined whenever zones are merged together."
+ (let* ((filtered-zones (zz-remove-zones-w-other-buffer-markers zones
buffer))
+ (flipped-zones (mapcar #'zz-zone-ordered filtered-zones))
+ (sorted-zones (sort flipped-zones #'zz-car-<)))
+ (zz-zone-union-1 sorted-zones)))
-\(zz-izone-limits (zz-izones-from-zones BASIC-ZONES)) = BASIC-ZONES
+(defun zz-zone-union-1 (zones)
+ "Helper for `zz-zone-union'."
+ (if (null (cdr zones))
+ zones
+ (let ((acc ())
+ new)
+ (while zones
+ (setq new (and (cdr zones) (zz-two-zone-union (car zones) (cadr
zones))))
+ (if new
+ (setq zones (cons new (cddr zones)))
+ (setq acc (cons (car zones) acc)
+ zones (cdr zones))))
+ (setq acc (nreverse acc)))))
-Also, (zz-izones-from-zones (zz-izone-limits)) returns the same set of
-izones as `zz-izones', but possibly with different IDs associated with
-the basic zones."
- (let ((ii 0))
- (nreverse (mapcar (lambda (zz) (cons (- (setq ii (1+ ii))) zz)) (reverse
basic-zones)))))
+(defun zz-car-< (zone1 zone2)
+ "Return non-nil if car of ZONE1 < car of ZONE2.
+Each car can be a number or a marker.
-;;;###autoload
-(defun zz-set-izones-var (variable &optional localp) ; Bound to `C-x n v'
- "Set `zz-izones-var' to VARIABLE, for which you are prompted.
-With a prefix arg, make VARIABLE automatically be buffer-local."
- (interactive (list (zz-read-any-variable "Variable: " zz-izones-var)
current-prefix-arg))
- (setq zz-izones-var variable)
- (when localp (make-variable-buffer-local variable)))
+* Two numbers or two markers in the same buffer: Use `<'.
+* Two markers in different buffers: Use `string<' of the buffer names.
+* Only one is a marker:
+ If its buffer is current then treat it as a number, using `<'.
+ Else return false if the marker is for ZONE1 and return true if it
+ is for ZONE2."
+ (let* ((p1 (car zone1))
+ (p2 (car zone2))
+ (m1 (markerp p1))
+ (m2 (markerp p2))
+ (b1 (and m1 (marker-buffer p1)))
+ (b2 (and m2 (marker-buffer p2))))
+ (cond ((and (not m1) (not m2)) (< p1 p2))
+ ((and m1 m2) (if (eq b1 b2) (< p1 p2) (string< (buffer-name b1)
(buffer-name b2))))
+ (m1 (and (eq (current-buffer) b1) (< p1 p2)))
+ (m2 (or (not (eq (current-buffer) b2)) (< p1 p2))))))
-;;;###autoload
-(defun zz-clone-zones (from-variable to-variable &optional msgp) ; Bound to
`C-x n c'
- "Clone FROM-VARIABLE to TO-VARIABLE.
-Return the new value of TO-VARIABLE.
-That is, copy the zones of FROM-VARIABLE to (emptied) TO-VARIABLE.
-A non-destructive operation: The value of TO-VARIABLE is a new list,
- with only the zones from FROM-VARIABLE.
-Return the value of TO-VARIABLE.
+(defun zz-two-zone-intersection (zone1 zone2)
+ "Return intersection of ZONE1 and ZONE2.
+\(The result is nil if they do not overlap.)
+Assumes that each zone is ordered (its car <= its cadr).
-You are prompted for FROM-VARIABLE and TO-VARIABLE.
+The cddr of a non-nil result (its list of EXTRA information) is the
+intersection of the EXTRA information of each zone:
-With a non-negative (>= 0) prefix arg, make TO-VARIABLE buffer-local.
-With a non-positive (<= 0) prefix arg, set `zz-izones-var' to the
-TO-VARIABLE symbol. (Zero: do both.)
+ (zz-set-intersection (cddr zone1) (cddr zone2))
-FROM-VARIABLE defaults to the value of `zz-izones-var'.
+This is a non-destructive operation: The result is a new list."
+ (and (zz-zones-overlap-p zone1 zone2) `(,(zz-max (car zone1) (car zone2))
+ ,(zz-min (cadr zone1) (cadr zone2))
+ ,@(zz-set-intersection (cddr
zone1) (cddr zone2)))))
-Non-interactively: Non-nil MSGP means show a status message."
- (interactive
- (let ((from-var (zz-read-any-variable "Copy variable: " zz-izones-var t))
- (to-var (zz-read-any-variable "To variable: "))
- (npref (and current-prefix-arg (prefix-numeric-value
current-prefix-arg))))
- (when (and npref (>= npref 0)) (make-local-variable to-var))
- (when (and npref (<= npref 0)) (setq zz-izones-var to-var))
- (list from-var to-var t)))
- (prog1 (set to-variable (copy-sequence (symbol-value from-variable)))
- (when msgp (message "Cloned `%s' to `%s'" from-variable to-variable))))
+(defun zz-zone-intersection (zones)
+ "Return the intersection of the zones in list ZONES.
+Each element of ZONES is a list of two zone limits, possibly followed
+by extra info: (LIMIT1 LIMIT2 . EXTRA), where EXTRA is a list.
-;;;###autoload
-(defalias 'zz-clone-and-coalesce-zones #'zz-clone-and-unite-zones)
-;;;###autoload
-(defun zz-clone-and-unite-zones (from-variable to-variable &optional msgp) ;
Bound to `C-x n C'
- "Clone FROM-VARIABLE to TO-VARIABLE, then unite (coalesce) TO-VARIABLE.
-That is, use`zz-clone-zones' to fill TO-VARIABLE, then use
-`zz-unite-zones' on TO-VARIABLE.
+The limits do not need to be in numerical order.
-Just as for `zz-clone-zones':
- With a non-negative (>= 0) prefix arg, make TO-VARIABLE buffer-local.
- With a non-positive (<= 0) prefix arg, set `zz-izones-var' to the
- TO-VARIABLE symbol. (Zero: do both.)
+Returns a new list, which is sorted by the lower limit of each zone,
+which is its car. (This is a non-destructive operation.)
-United zones are in ascending order of their cars.
-Return the new value of TO-VARIABLE.
+Each zone in ZONES is first ordered, so that its car <= its cadr.
+The resulting zones are then sorted by their cars.
-Use this when you do not want to unite the zones of FROM-VARIABLE (for
-example, you want to use them as possibly overlapping buffer
-narrowings), but you also want to act on the united zones (for
-example, to search them).
+`zz-two-zone-intersection' is then applied recursively to combine
+overlapping zones. This means also that any EXTRA info is combined
+when zones are merged together."
+ (let* ((flipped-zones (mapcar #'zz-zone-ordered zones))
+ (sorted-zones (sort flipped-zones (lambda (z1 z2) (< (car z1) (car
z2))))))
+ (zz-zone-intersection-1 sorted-zones)))
-FROM-VARIABLE defaults to the value of `zz-izones-var'.
+(defun zz-zone-intersection-1 (zones)
+ "Helper for `zz-zone-intersection'."
+ (if (null (cdr zones))
+ zones
+ (let ((new (zz-two-zone-intersection (car zones) (cadr zones))))
+ (and new (zz-zone-intersection-1 (cons new (cddr zones)))))))
+
+;; From `cl-seq.el', function `union', without keyword treatment.
+(defun zz-set-union (list1 list2)
+ "Combine LIST1 and LIST2 using a set-union operation.
+The result list contains all items that appear in either LIST1 or
+LIST2. This is a non-destructive function: it copies the data if
+necessary."
+ (cond ((null list1) list2)
+ ((null list2) list1)
+ ((equal list1 list2) list1)
+ (t
+ (unless (>= (length list1) (length list2)) (setq list1 (prog1 list2
(setq list2 list1)))) ; Swap.
+ (while list2
+ (unless (member (car list2) list1) (setq list1 (cons (car list2)
list1)))
+ (setq list2 (cdr list2)))
+ list1)))
-Non-interactively: Non-nil MSGP means show a status message."
- (interactive
- (let ((from-var (zz-read-any-variable "Copy variable: " zz-izones-var t))
- (to-var (zz-read-any-variable "To variable: "))
- (npref (and current-prefix-arg (prefix-numeric-value
current-prefix-arg))))
- (when (and npref (>= npref 0)) (make-local-variable to-var))
- (when (and npref (<= npref 0)) (setq zz-izones-var to-var))
- (list from-var to-var t)))
- (set to-variable (copy-sequence (symbol-value from-variable)))
- (prog1 (zz-unite-zones to-variable)
- (when msgp (message "Cloned `%s' to `%s' and united `%s'" from-variable
to-variable to-variable))))
+;; From `cl-seq.el', function `intersection', without keyword treatment.
+(defun zz-set-intersection (list1 list2)
+ "Set intersection of lists LIST1 and LIST2.
+This is a non-destructive operation: it copies the data if necessary."
+ (and list1 list2
+ (if (equal list1 list2)
+ list1
+ (let ((result ()))
+ (unless (>= (length list1) (length list2)) (setq list1 (prog1
list2 (setq list2 list1)))) ; Swap.
+ (while list2
+ (when (member (car list2) list1) (setq result (cons (car list2)
result)))
+ (setq list2 (cdr list2)))
+ result))))
-;;;###autoload
-(defalias 'zz-coalesce-zones #'zz-unite-zones)
-;;;###autoload
-(defun zz-unite-zones (&optional variable msgp) ; Bound to `C-x n u'
- "Coalesce (unite) the izones of VARIABLE.
-A non-destructive operation: The new value of VARIABLE is a new list.
-Return the new value of VARIABLE.
+(defun zz-min (&rest ns)
+ "Like `min', but if the args include a marker then return a marker.
+Raise an error if the args include markers from different buffers."
+ (let ((buf (zz-buffer-of-markers ns))
+ (min (apply #'min ns)))
+ (if (not buf)
+ min
+ (with-current-buffer (get-buffer-create buf) (set-marker (copy-marker
min) min buf)))))
-United zones are in ascending order of their cars.
+(defun zz-max (&rest ns)
+ "Like `max', but if the args include a marker then return a marker.
+Raise an error if the args include markers from different buffers."
+ (let ((buf (zz-buffer-of-markers ns))
+ (max (apply #'max ns)))
+ (if (not buf)
+ max
+ (with-current-buffer (get-buffer-create buf) (set-marker (copy-marker
max) max buf)))))
-VARIABLE defaults to the value of `zz-izones-var'.
-With a prefix arg you are prompted for a different variable to use, in
-place of the current value of `zz-izones-var'. If the prefix arg is
-non-negative (>= 0) then make the variable buffer-local. If the
-prefix arg is non-positive (<= 0) then set `zz-izones-var' to that
-variable symbol. (Zero: do both.)
+(defun zz-buffer-of-markers (ns)
+ "Return the buffer of the markers in list NS, or nil if no markers.
+Raise an error if NS contains markers from different buffers."
+ (let ((mkr (car (zz-some #'markerp ns))))
+ (and mkr
+ (progn
+ (unless (zz-every (lambda (nn) (or (not (markerp nn)) (eq
(marker-buffer nn) (marker-buffer mkr)))) ns)
+ (error "List contains markers from different buffers"))
+ t)
+ (marker-buffer mkr))))
-Non-interactively:
-* VARIABLE is the optional izones variable to use.
-* Non-nil MSGP means show a status message."
- (interactive (let* ((var (and current-prefix-arg (zz-read-any-variable
"Variable: " zz-izones-var t)))
- (npref (prefix-numeric-value current-prefix-arg)))
- (when (and current-prefix-arg (>= npref 0))
(make-local-variable var))
- (when (and current-prefix-arg (<= npref 0)) (setq
zz-izones-var var))
- (list var t)))
- (let* ((var (or variable zz-izones-var))
- (_IGNORE (unless (boundp var) (set var ())))
- (val (symbol-value var))
- (_IGNORE (unless (zz-izones-p val) (error "Not an izones
variable: `%s', value: `%S'" var val)))
- (zone-union (zz-zone-union (zz-izone-limits val))))
- (set var (zz-izones-from-zones zone-union))
- (when msgp
- (let ((len (length (symbol-value var))))
- (message "Zones united for variable `%s': %d zone%s now" var len (if
(> len 1) "s" ""))))
- (symbol-value var)))
+;; Similar to `every' in `cl-extra.el', without non-list sequences and multiple
+;; sequences.
+(defun zz-every (predicate list)
+ "Return t if PREDICATE is true for all elements of LIST; else nil."
+ (while (and list (funcall predicate (car list))) (setq list (cdr list)))
+ (null list))
-;;;###autoload
-(defalias 'zz-add-zone-and-coalesce #'zz-add-zone-and-unite)
-;;;###autoload
-(defun zz-add-zone-and-unite (start end &optional variable msg) ; Bound to
`C-x n A'.
- "Add an izone from START to END to those of VARIABLE, and coalesce.
-Use `zz-add-zone', then apply `zz-unite-zones'.
-United zones are in ascending order of their cars.
-Return the new value of VARIABLE.
+;; Same as `bmkp-some' in `bookmark+-1.el'.
+;; This is NOT the same as `some' in `cl-extra.el', even without non-list
sequences and multiple sequences.
+;;
+;; If PREDICATE is satisfied by a list element ELEMENT, so that it returns a
non-nil value VALUE for ELEMENT,
+;; then this returns the cons (ELEMENT . VALUE). It does not return just
VALUE.
+(defun zz-some (predicate list)
+ "Return non-nil if PREDICATE applied to some element of LIST is true.
+The value returned is a cons, (ELEMENT . VALUE), where ELEMENT is the
+first list element that satisfies PREDICATE and VALUE is the value of
+PREDICATE applied to ELEMENT."
+ (let (elt val)
+ (catch 'zz-some
+ (while list
+ (when (setq val (funcall predicate (setq elt (pop list)))) (throw
'zz-some (cons elt val))))
+ nil)))
-This is a destructive operation: The list structure of the variable
-value can be modified.
+(defun zz-narrowing-lighter ()
+ "Update minor-mode mode-line lighter to reflect narrowing/widening.
+Put `zz-narrow' on `mouse-2' for the lighter suffix."
+ (let* ((%n-cons (zz-regexp-car-member "%n\\(.*\\)\\'" mode-line-modes)))
+ (when %n-cons
+ (setcar %n-cons (replace-regexp-in-string "%n\\(.*\\)"
+ (if (zz-buffer-narrowed-p)
zz-lighter-narrowing-part "")
+ (car %n-cons) nil nil 1))
+ (when (> (length (car %n-cons)) 2)
+ (set-text-properties 2
+ (length (car %n-cons))
+ '(local-map (keymap (mode-line keymap (mouse-2 .
zz-narrow)))
+ mouse-face mode-line-highlight
+ help-echo "mouse-2: Next Restriction")
+ (car %n-cons)))
+ ;; Dunno why we need to do this. Tried adjusting `rear-sticky' and
`front-sticky',
+ ;; but without this the whole field (not just the suffix) gets changed,
in effect, to the above spec.
+ (set-text-properties 0 2 '(local-map (keymap (mode-line keymap (mouse-2
. mode-line-widen)))
+ mouse-face mode-line-highlight help-echo
"mouse-2: Widen")
+ (car %n-cons)))))
-VARIABLE defaults to the value of `zz-izones-var'.
-START and END are as for `narrow-to-region'.
+(defun zz-regexp-car-member (regexp xs)
+ "Like `member', but tests by matching REGEXP against cars."
+ (and (consp xs) (if (and (stringp (car xs)) (zz-string-match-p regexp (car
xs)))
+ xs
+ (zz-regexp-car-member regexp (cdr xs)))))
-With a prefix arg you are prompted for a different variable to use, in
-place of the current value of `zz-izones-var'. If the prefix arg is
-non-negative (>= 0) then make the variable buffer-local. If the
-prefix arg is non-positive (<= 0) then set `zz-izones-var' to that
-variable symbol. (Zero: do both.)
+(defun zz-markerize (izone)
+ "Convert IZONE to use markers.
+IZONE is a list of an identifier (a number) and two buffer
+positions (numbers, markers, or readable-marker objects). Positions
+that are numbers or readable-marker objects are converted to markers.
-Non-interactively:
-* VARIABLE is the optional izones variable to use.
-* Non-nil MSG means echo messages for adding the zone and uniting
- zones. In this case MSG is the message prefix for `zz-add-zone'."
- (interactive (let ((beg (region-beginning))
- (end (region-end))
- (var (or (and current-prefix-arg
(zz-read-any-variable "Variable: " zz-izones-var))
- zz-izones-var))
- (npref (prefix-numeric-value current-prefix-arg)))
- (when (and current-prefix-arg (>= npref 0))
(make-local-variable var))
- (when (and current-prefix-arg (<= npref 0)) (setq
zz-izones-var var))
- (list beg end var "Zone recorded: ")))
- (unless variable (setq variable zz-izones-var))
- (zz-add-zone start end variable nil nil msg)
- (zz-unite-zones variable msg)
- (symbol-value variable))
+This is a non-destructive operation: it returns a new list."
+ (let ((ii 1)
+ posn)
+ (while (< ii 3)
+ (setq posn (nth ii izone))
+ (when (and (not (markerp posn)) (or (natnump posn)
(zz-readable-marker-p posn)))
+ (setcar (nthcdr ii izone) (zz-marker-from-object posn)))
+ (setq ii (1+ ii))))
+ izone)
-;;;###autoload
-(defun zz-add-zones-matching-regexp (regexp ; Bound to `C-x n r'
- &optional variable beg end
not-buf-local-p set-var-p msgp)
- "Add matches for REGEXP as zones to the izones of VARIABLE.
-If region is active, limit action to region. Else, use whole buffer.
-Return the new value of VARIABLE.
+(defun zz-marker-from-object (object)
+ "Return an equivalent marker for OBJECT.
+This is a non-destructive operation: OBJECT is not modified.
-If `isearchp-dim-outside-search-area-flag' is non-nil then dim the
-non-contexts. (You can use `\\[isearchp-remove-dimming]' or \
-`\\[isearchp-toggle-dimming-outside-search-area]' to remove the
-dimming.)
+If OBJECT is a marker then return it.
+If it is a number then return (copy-marker OBJECT).
+If it is a readable-marker sexp then return an equivalent real marker.
+Otherwise, return nil.
-See `zz-add-zone' for a description of VARIABLE, the use of a prefix
-arg, and the parameters when called from Lisp."
- (interactive
- (let* ((regx (read-regexp "Add zones matching regexp: "))
- (var (or (and current-prefix-arg (zz-read-any-variable
"Variable: " zz-izones-var t))
- zz-izones-var))
- (beg (if (and transient-mark-mode mark-active)
(region-beginning) (point-min)))
- (end (if (and transient-mark-mode mark-active) (region-end)
(point-max)))
- (npref (prefix-numeric-value current-prefix-arg))
- (nloc (and current-prefix-arg (<= npref 0) (not (boundp var))))
- (setv (and current-prefix-arg (or (consp current-prefix-arg) (=
npref 0)))))
- (list regx var beg end nloc setv t)))
- (unless (and beg end) (setq beg (point-min)
- end (point-max)))
- (unless (< beg end) (setq beg (prog1 end (setq end beg))))
- (let ((last-beg nil)
- (num-hits 0))
- (condition-case-unless-debug zz-add-zones-matching-regexp
- (save-excursion
- (goto-char (setq last-beg beg))
- (while (and beg (< beg end) (not (eobp))
- (progn (while (and (setq beg (re-search-forward regexp
end t))
- (eq last-beg beg)
- (not (eobp)))
- ;; Matched again, same place. Advance 1 char.
- (forward-char) (setq beg (1+ beg)))
- beg)) ; Stop if no more matches.
- (setq num-hits (1+ num-hits))
- (let* ((hit-beg (match-beginning 0))
- (hit-end (match-end 0))
- (hit-string (buffer-substring-no-properties hit-beg
hit-end))
- (c-beg last-beg)
- (c-end (if beg (match-beginning 0) (min end
(point-max)))) ; Truncate.
- end-marker)
- (isearchp-add/remove-dim-overlay c-beg c-end 'ADD)
- (cond ((not (string= "" hit-string))
- (zz-add-zone c-beg c-end variable not-buf-local-p
set-var-p)
- (isearchp-add/remove-dim-overlay hit-beg hit-end nil))
- (t
- (isearchp-add/remove-dim-overlay hit-beg hit-end 'ADD))))
- (goto-char (setq last-beg beg))))
- (error (error "%s" (error-message-string zz-add-zones-matching-regexp))))
- (unless (> num-hits 0) (zz-user-error "No regexp matches"))
- (when msgp
- (let ((dim-msg (if (not (bound-and-true-p
- isearchp-dim-outside-search-area-flag))
- ""
- (substitute-command-keys
- "; `\\[isearchp-remove-dimming]' or \
-`\\[isearchp-toggle-dimming-outside-search-area]' removes dimming"))))
- (case num-hits
- (1 (message "1 zone added%s" dim-msg))
- (t (message "%d zones added or updated%s" num-hits dim-msg)))))
- variable))
+A readable marker is a sexp of form (marker BUFFER POSITION), where
+BUFFER is a buffer name (string) and POSITION is a buffer position
+\(number)."
+ (cond ((markerp object) object)
+ ((numberp object) (copy-marker object))
+ ((zz-readable-marker-p object)
+ (with-current-buffer (get-buffer-create (nth 1 object)) (copy-marker
(nth 2 object))))
+ (t nil)))
-;;;###autoload
-(defun zz-set-zones-matching-regexp (regexp ; Bound to `C-x n R'
- &optional variable beg end
not-buf-local-p set-var-p msgp)
- "Replace value of izones variable with zones matching REGEXP.
-Like `zz-add-zones-matching-regexp' (which see), but it replaces any
-current zones instead of adding to them."
- (interactive
- (let* ((var (or (and current-prefix-arg (zz-read-any-variable
"Variable: " zz-izones-var t))
- zz-izones-var))
- (regx (read-regexp (format "Set `%s' to zones matching regexp: "
var)))
- (beg (if (and transient-mark-mode mark-active)
(region-beginning) (point-min)))
- (end (if (and transient-mark-mode mark-active) (region-end)
(point-max)))
- (npref (prefix-numeric-value current-prefix-arg))
- (nloc (and current-prefix-arg (<= npref 0) (not (boundp var))))
- (setv (and current-prefix-arg (or (consp current-prefix-arg) (=
npref 0)))))
- (list regx var beg end nloc setv t)))
- (set variable ())
- (zz-add-zones-matching-regexp regexp variable beg end not-buf-local-p
set-var-p msgp))
+(defun zz-number-or-marker-p (position)
+ "Return non-nil if POSITION is a number, marker, or readable-marker object."
+ ;; Just like `number-or-marker-p', We don't check that a number arg is a
positive integer.
+ (or (number-or-marker-p position) (zz-readable-marker-p position)))
-;;;###autoload
-(defun zz-add-zones-from-highlighting ( ; Bound to `C-x n l'
- &optional start end face only-hlt-face
overlay/text fonk-lock-p msgp)
- "Add highlighted areas as zones to izones variable.
-By default, the text used is that highlighted with `hlt-last-face'.
-With a non-negative prefix arg you are instead prompted for the face.
+(defun zz-readable-marker-p (object)
+ "Return non-nil if OBJECT is a readable marker.
+That is, it has form (marker BUFFER POSITION), where BUFFER is a
+buffer name (string), and POSITION is a buffer position (integer).
+OBJECT is returned."
+ (and (consp object) (consp (cdr object)) (consp (cddr object))
+ (eq 'marker (nth 0 object)) (stringp (nth 1 object)) (integerp (nth 2
object))
+ object))
-With a non-positive prefix arg use face property `font-lock-face'
-instead of property `face'.
+(defun zz-readable-marker (number-or-marker &optional num-buffer)
+ "Return a readable marker equivalent to NUMBER-OR-MARKER, or nil.
+Return nil if NUMBER-OR-MARKER is not `number-or-marker-p'.
+\(If NUMBER-OR-MARKER is already a readable marker then return it.)
-The izones variable to use is the value of `zz-izones-var'. You can
-set this to a different variable anytime using `\\[zz-set-izones-var]'.
+A readable marker satisfies `zz-readable-marker-p'. It has the form
+\(marker BUFFER POSITION), where BUFFER is a buffer name (string) and
+POSITION is a buffer position (number).
-All highlighting is checked, both overlays and face text properties.
+If NUMBER-OR-MARKER is itself a readable marker then return it.
-The number of highlighted areas added as zones is echoed in a message.
-This might be less than the number of zones added, because there can
-be multiple highlights with the same face for the same area.
+If NUMBER-OR-MARKER is a marker then use its buffer name as BUFFER.
-When called from Lisp:
+If NUMBER-OR-MARKER is a number then:
+ If NUM-BUFFER names an existing buffer then use it as BUFFER.
+ Else use the name of the current buffer as BUFFER.
-* Non-nil START and END are the buffer limits to search.
-* Non-nil FACE is the highlighting face to look for.
-* Non-nil ONLY-HLT-FACE means check only `highlight.el' highlighting.
- (By default, any highlighting is checked.)
-* If OVERLAY/TEXT is `text-prop' then only text-property highlighting
- is checked. If it is `overlay' then only overlay highlighting is
- checked. (If nil then both are checked.)
-* Non-nil FONK-LOCK-P means check property `font-lock-face'. By
- default (nil), check property `face'."
- (interactive
- (let ((numarg (and current-prefix-arg (prefix-numeric-value
current-prefix-arg))))
- (unless (require 'highlight nil t) (zz-user-error "You need library
`highlight.el' to use this command"))
- `(,@(hlt-region-or-buffer-limits)
- ,(if (natnump numarg)
- (hlt-read-bg/face-name "Create zones highlighted with face: ")
- hlt-last-face)
- nil nil ,(and numarg (<= numarg 0)) t)))
- (require 'highlight)
- (unless (and start end) (let ((start-end (hlt-region-or-buffer-limits)))
- (setq start (car start-end)
- end (cadr start-end))))
- (unless face (setq face hlt-last-face))
- (let ((hlt-use-overlays-flag (case overlay/text
- (text-prop nil) ; Only text property
- (overlay 'only) ; Only overlay
- (t t))) ; Default: both
- (hlt-act-on-any-face-flag (not only-hlt-face))
- (hlt-face-prop (if fonk-lock-p 'font-lock-face 'face))
- (count 0))
- (save-excursion
- (save-window-excursion
- (goto-char start)
- (let ((zone-beg start)
- zone-end zone)
- (while (and zone-beg (< zone-beg end))
- (setq zone (hlt-next-highlight zone-beg end face nil nil
'no-error-msg)
- zone-beg (car zone)
- zone-end (cdr zone))
- ;; Create zone from `zone-beg' to `zone-end' if highlighted. Add
it to zones list.
- (when hlt-use-overlays-flag
- (let ((overlays (overlays-at zone-beg)))
- (while overlays
- (when (and (or hlt-act-on-any-face-flag
- (equal face (overlay-get (car overlays)
'hlt-highlight)))
- (equal face (overlay-get (car overlays)
hlt-face-prop)))
- (zz-add-zone zone-beg zone-end)
- (setq count (1+ count)))
- (when overlays (setq overlays (cdr overlays))))))
- (when (and (not (eq hlt-use-overlays-flag 'only))
- (or hlt-act-on-any-face-flag (equal face
(get-text-property (point) 'hlt-highlight)))
- (let ((pt-faces (get-text-property (point)
hlt-face-prop)))
- (if (consp pt-faces) (memq face pt-faces) (equal face
pt-faces))))
- (zz-add-zone zone-beg zone-end)
- (setq count (1+ count)))))))
- (when msgp
- (case count
- (0 (message "NO zones added or updated"))
- (1 (message "1 zone added or updated"))
- (t (message "%s highlighted areas added or updated as zones"
count))))))
+This is a non-destructive operation."
+ ;; Just like `number-or-marker-p', We don't check that a number arg is a
positive integer.
+ (cond ((zz-readable-marker-p number-or-marker) number-or-marker)
+ ((markerp number-or-marker)
+ `(marker ,(buffer-name (marker-buffer number-or-marker))
,(marker-position number-or-marker)))
+ ((numberp number-or-marker)
+ `(marker
+ ,(buffer-name (or (and (stringp num-buffer) (get-buffer
num-buffer)) (current-buffer)))
+ ,number-or-marker))
+ (t nil)))
-;;;###autoload
-(defun zz-set-zones-from-highlighting ( ; Bound to `C-x n L'
- &optional start end face only-hlt-face
overlay/text fonk-lock-p msgp)
- "Replace value of izones variable with zones from the highlighted areas.
-Like `zz-add-zones-from-highlighting' (which see), but it replaces any
-current zones instead of adding to them."
- (interactive
- (let ((numarg (and current-prefix-arg (prefix-numeric-value
current-prefix-arg))))
- (unless (require 'highlight nil t) (zz-user-error "You need library
`highlight.el' to use this command"))
- `(,@(hlt-region-or-buffer-limits)
- ,(if (natnump numarg)
- (hlt-read-bg/face-name "Create zones highlighted with face: ")
- hlt-last-face)
- nil nil ,(and numarg (<= numarg 0)) t)))
- (set zz-izones-var ())
- (zz-add-zones-from-highlighting start end face only-hlt-face overlay/text
fonk-lock-p msgp))
+(defun zz-izones-p (value)
+ "Return non-nil if VALUE is a (possibly empty) list of izones.
+That is, non-nil means that VALUE has the form of `zz-izones'."
+ (and (listp value) (listp (cdr (last value))) ; Proper list.
+ (let ((res t))
+ (catch 'zz-izones-p
+ (dolist (xx value) (unless (setq res (zz-izone-p xx)) (throw
'zz-izones-p nil))))
+ res)))
-;;;###autoload
-(defun zz-set-zones-from-face (face &optional start end variable _msgp) ;
Bound to `C-x n f'
- "Set an izones variable to (united) zones of a face or background color.
-You are prompted for a face name or a color name. If you enter a
-color, it is used for the face background. The face foreground is
-determined by the value of `hlt-auto-face-foreground'.
-The variable defaults to `zz-izones'. With a prefix arg you are
- prompted for a different izones variable."
- (interactive
- (progn
- (unless (require 'highlight nil t)
- (error "You need library `highlight.el' for this command"))
- (let ((fac (hlt-read-bg/face-name "Choose background color or face: "
- (and (symbolp hlt-last-face)
(symbol-name hlt-last-face))))
- (var (or (and current-prefix-arg (zz-read-any-variable "Variable:
" zz-izones-var))
- zz-izones-var)))
- (if (hlt-nonempty-region-p)
- (if (< (point) (mark)) (list (point) (mark) var t) (list (mark)
(point) var t))
- (list fac (point-min) (point-max) var t)))))
- (unless (require 'highlight nil t)
- (error "You need library `highlight.el' for this command"))
- (unless (require 'isearch-prop nil t)
- (error "You need library `isearch-prop.el' for this command"))
- (unless (require 'zones nil t)
- (error "You need library `zones' for this command"))
- (font-lock-default-fontify-buffer) ; Fontify the whole buffer.
- (zz-set-zones-from-highlighting start end face nil 'text-prop)
- (zz-unite-zones variable t))
+(defun zz-izone-p (value)
+ "Return non-nil if VALUE is an izone.
+That is, non-nil means it has the form (ID POS1 POS2 . EXTRA),
+where ID is a negative integer, and each POS<N> is a buffer-position
+representation (`zz-number-or-marker-p')."
+ (and (consp value) (condition-case nil
+ (and (integerp (nth 0 value))
+ (< (nth 0 value) 0)
+ (zz-number-or-marker-p (nth 1 value))
+ (zz-number-or-marker-p (nth 2 value)))
+ (error nil))))
+
+(defun zz-rassoc-delete-all (value alist)
+ "Delete from ALIST all elements whose cdr is `equal' to VALUE.
+Elements of ALIST that are not conses are ignored.
+Return the modified alist.
+This is a destructive operation."
+ (while (and (consp (car alist)) (equal (cdar alist) value)) (setq alist
(cdr alist)))
+ (let ((tail alist)
+ tail-cdr)
+ (while (setq tail-cdr (cdr tail))
+ (if (and (consp (car tail-cdr)) (equal (cdar tail-cdr) value))
+ (setcdr tail (cdr tail-cdr))
+ (setq tail tail-cdr))))
+ alist)
-;;---------------------
-;; Put all toggle commands on prefix key `M-='.
+(defun zz-izones-renumber (&optional variable)
+ "Renumber the izones of this buffer in the current `zz-izones-var'.
+This is a destructive operation: The list structure of the variable
+value can be modified."
+ (let* ((var (or variable zz-izones-var))
+ (orig (symbol-value var)))
+ (set var ())
+ (dolist (iz orig) (zz-add-zone (cadr iz) (car (cddr iz)) var))))
+
+;; Non-destructive version.
;;
-(defvar zz-toggles-map nil
- "Keymap containing bindings for toggle commands for zones.")
-(define-prefix-command 'zz-toggles-map)
+;; (defun zz-izone-limits-in-bufs (buffers &optional variable)
+;; "Return a list of all `zz-izone-limits' for each buffer in BUFFERS.
+;; That is, return a list of all recorded buffer zones for BUFFERS.
+;; If BUFFERS is nil, return the zones recorded for the current buffer.
+;;
+;; This is a non-destructive operation: The list returned is independent
+;; of the `zz-izone-limits' list in each of the buffers.
+;;
+;; Optional arg VARIABLE is the izones variable to use. If nil,
+;; use the value of `zz-izones-var'. The variable is evaluated in each
+;; buffer (or in the current buffer, if BUFFERS is nil)."
+;;
+;; (let ((limits ()))
+;; (dolist (buf (or (reverse buffers) (list (current-buffer)))) ;
Reverse so we keep the order.
+;; (with-current-buffer buf
+;; (setq limits (append (zz-izone-limits (symbol-value (or variable
zz-izones-var))
+;; buf
+;; 'ONLY-THIS-BUFFER)
+;; limits))))
+;; limits))
-(defun zz-add-key-bindings-to-narrow-map (bindings)
- "Add BINDINGS to `narrow-map'.
-\(For Emacs prior to Emacs 24, add bindings to prefix key `C-x n'.)"
- (let ((map (if (boundp 'narrow-map) narrow-map (lookup-key ctl-x-map "n"))))
- (when (keymapp map)
- (dolist (binding bindings)
- (let ((kseq (car binding))
- (cmd (cdr binding)))
- (unless (lookup-key map kseq) (define-key map kseq cmd)))))))
+(defun zz-izone-limits-in-bufs (buffers &optional variable)
+ "Return a list of all `zz-izone-limits' for each buffer in BUFFERS.
+That is, return a list of all recorded buffer zones for BUFFERS.
+If BUFFERS is nil, return the zones recorded for the current buffer.
+
+This is a destructive operation: The list returned can have as
+sublists the `zz-izone-limits' lists of BUFFERS.
+
+Optional arg VARIABLE is the izones variable to use. If nil, use the
+value of `zz-izones-var'. The variable is evaluated in each
+buffer (or in the current buffer, if BUFFERS is nil)."
+ (let ((limits ()))
+ (dolist (buf (or buffers (list (current-buffer))))
+ (with-current-buffer buf
+ (setq limits (nconc limits (zz-izone-limits (symbol-value (or
variable zz-izones-var)) buf 'THISBUF)))))
+ limits))
-(zz-add-key-bindings-to-narrow-map '(("\M-=" . zz-toggles-map)
- ("a" . zz-add-zone)
; C-x n a
- ("A" . zz-add-zone-and-unite)
; C-x n A
- ("c" . zz-clone-zones)
; C-x n c
- ("C" . zz-clone-and-unite-zones)
; C-x n C
- ("\C-d" . zz-delete-zone)
; C-x n C-d
- ("\C-x" . zz-select-zone-repeat)
; C-x n C-x
- ("#" . zz-select-zone-by-id-and-text)
; C-x n #
- ("u" . zz-unite-zones)
; C-x n u
- ("v" . zz-set-izones-var)
; C-x n v
- ("x" . zz-narrow-repeat)
; C-x n x
- ))
+(defun zz-izone-limits (izones &optional buffer only-one-buffer-p)
+ "Return a list like IZONES, but with no identifiers.
+That is, return a list of zones, (LIMIT1 LIMIT2 . EXTRA).
-(eval-after-load "highlight"
- '(zz-add-key-bindings-to-narrow-map '(("h" . hlt-highlight-regions)
; C-x n h
- ("H" .
hlt-highlight-regions-in-buffers) ; C-x n H
- ("l" . zz-add-zones-from-highlighting)
; C-x n l
- ("L" . zz-set-zones-from-highlighting)
; C-x n L
- )))
+This is a non-destructive operation: A new list is returned.
-(eval-after-load "isearch-prop"
- '(progn
- (zz-add-key-bindings-to-narrow-map `(("D" . isearchp-remove-dimming)
; C-x n D
- ("P" .
isearchp-put-prop-on-zones) ; C-x n P
- ("r" .
zz-add-zones-matching-regexp) ; C-x n r
- ("R" .
zz-set-zones-matching-regexp) ; C-x n R
- ("\C-r" . isearchp-zones-backward)
; C-x n C-r
- ("\C-\M-r" .
isearchp-zones-backward-regexp) ; C-x n C-M-r
- ("\C-s" . isearchp-zones-forward)
; C-x n C-s
- ("\C-\M-s" .
isearchp-zones-forward-regexp) ; C-x n C-M-s
- ("\M-%" . zz-query-replace-zones)
; C-x n M-%
- (,(kbd "C-M-%") .
zz-query-replace-regexp-zones) ; C-x n C-M-%
-;; ("???" . zz-replace-regexp-zones)
-;; ("???" . zz-replace-string-zones)
-;; ("???" .
zz-map-query-replace-regexp-zones)
-;; ("???" .
isearchp-make-anti-zones-invisible)
-;; ("???" .
isearchp-make-anti-zones-visible)
-;; ("???" .
isearchp-make-zones-invisible)
-;; ("???" . isearchp-make-zones-visible)
-;; ("???" .
isearchp-toggle-zone/anti-zone-visibility)
- ))
- (define-key zz-toggles-map (kbd "d")
'isearchp-toggle-dimming-outside-search-area) ; C-x n M-= d
- (define-key zz-toggles-map (kbd "v")
'isearchp-toggle-anti-zones-invisible) ; C-x n M-= v
- (define-key zz-toggles-map (kbd "V") 'isearchp-toggle-zones-invisible)
; C-x n M-= V
- (define-key zz-toggles-map (kbd "~")
'isearchp-toggle-complementing-domain) ; C-x n M-= ~
- ))
+Each limit can be a number or a marker (but see ONLY-ONE-BUFFER-P).
+The conses are new - they do not share with any conses with IZONES.
+IZONES has the same structure as `zz-izones'.
+The default value of IZONES is the value of the variable that is the
+value of `zz-izones-var'. This variable is evaluated in BUFFER
+\(default: current buffer) to obtain the izones.
-;; Call `zz-add-zone' if interactive or if `zz-add-zone-anyway-p'.
+Non-nil optional arg ONLY-ONE-BUFFER-P means remove any izones that
+contain markers for a buffer other than BUFFER."
+ (let ((restrs izones))
+ (when only-one-buffer-p
+ (setq restrs (zz-remove-izones-w-other-buffer-markers restrs (or buffer
(current-buffer)))))
+ (delq nil (mapcar #'cdr restrs))))
-(defun zz-narrow-advice (interactive-p)
- (when (or interactive-p zz-add-zone-anyway-p)
- (zz-add-zone (point-min) (point-max) nil nil nil "Narrowed, and recorded
zone: ")))
+;; Useful for commands that want to act on zones in multiple buffers.
+(defun zz-read-bufs ()
+ "Read names of buffers, one at a time. `C-g' ends reading."
+ (let ((bufs ())
+ buf)
+ (while (condition-case nil
+ (setq buf (read-buffer "Buffer (C-g to end): "
+ (and (not (member (buffer-name
(current-buffer)) bufs))
+ (current-buffer))
+ t))
+ (quit nil))
+ (push buf bufs))
+ (delq nil (mapcar #'get-buffer (nreverse bufs)))))
-(defadvice narrow-to-region (after zz-add-zone--region activate)
- "Push the region limits to the current `zz-izones-var'.
-You can use `C-x n x' to widen to a previous buffer restriction.
+(defun zz-remove-zones-w-other-buffer-markers (zones &optional buffer)
+ "Return ZONES, but remove any that use markers for another buffer.
+BUFFER is the buffer to compare with (default: current buffer).
+This is a non-destructive operation: a (shallow) copy is returned."
+ (unless buffer (setq buffer (current-buffer)))
+ (zz-remove-if `(lambda (zone) (zz-zone-has-other-buffer-marker-p zone
',buffer)) zones))
-This is a destructive operation. The list structure of the variable
-value can be modified."
- (zz-narrow-advice (interactive-p)))
+(defun zz-remove-izones-w-other-buffer-markers (izones &optional buffer)
+ "Return IZONES, but remove any that use markers for another buffer.
+BUFFER is the buffer to compare with (default: current buffer).
+This is a non-destructive operation: a (shallow) copy is returned."
+ (unless buffer (setq buffer (current-buffer)))
+ (zz-remove-if `(lambda (izone) (zz-izone-has-other-buffer-marker-p izone
',buffer)) izones))
-(defadvice narrow-to-defun (after zz-add-zone--defun activate)
- "Push the defun limits to the current `zz-izones-var'.
-You can use `C-x n x' to widen to a previous buffer restriction.
+(defun zz-zone-has-other-buffer-marker-p (zone &optional buffer)
+ "Return non-nil if basic ZONE has a marker for another buffer.
+The first marker in the zone is returned.
+BUFFER is the buffer to compare with (default: current buffer)."
+ (unless buffer (setq buffer (current-buffer)))
+ (let ((m1 (nth 0 zone))
+ (m2 (nth 1 zone)))
+ (or (and (markerp m1) (not (eq buffer (marker-buffer m1))) m1)
+ (and (markerp m2) (not (eq buffer (marker-buffer m2))) m2))))
-This is a destructive operation. The list structure of the variable
-value can be modified."
- (zz-narrow-advice (interactive-p)))
+(defun zz-izone-has-other-buffer-marker-p (izone &optional buffer)
+ "Return non-nil if IZONE has a marker for another buffer.
+The first marker in the izone is returned.
+BUFFER is the buffer to compare with (default: current buffer)."
+ (unless buffer (setq buffer (current-buffer)))
+ (let ((m1 (nth 1 izone))
+ (m2 (nth 2 izone)))
+ (or (and (markerp m1) (not (eq buffer (marker-buffer m1))) m1)
+ (and (markerp m2) (not (eq buffer (marker-buffer m2))) m2))))
-;; Call `zz-add-zone' if interactive or `zz-add-zone-anyway-p'.
+(defun zz-remove-if (pred xs)
+ "A copy of list XS with no elements that satisfy predicate PRED."
+ (let ((result ()))
+ (dolist (x xs) (unless (funcall pred x) (push x result)))
+ (nreverse result)))
+
+;; Useful for commands that want to act on zones in multiple buffers (e.g.,
visible buffers only).
;;
-(defadvice narrow-to-page (after zz-add-zone--defun activate)
- "Push the page limits to the current `zz-izones-var'.
-You can use `C-x n x' to widen to a previous buffer restriction.
+;; Same as `icicle-remove-if-not' etc.
+(defun zz-remove-if-not (pred xs)
+ "A copy of list XS with only elements that satisfy predicate PRED."
+ (let ((result ()))
+ (dolist (x xs) (when (funcall pred x) (push x result)))
+ (nreverse result)))
-This is a destructive operation. The list structure of the variable
-value can be modified."
- (zz-narrow-advice (interactive-p)))
+;; Like `read-any-variable' in `strings.el', but passes REQUIRE-MATCH arg to
`completing-read'.
+(defun zz-read-any-variable (prompt &optional default-value require-match)
+ "Read the name of a variable and return it as a symbol.
+Prompts with string PROMPT. By default, returns DEFAULT-VALUE if
+non-nil. If DEFAULT-VALUE is nil and the nearest symbol to the cursor
+is a variable, then return that by default.
+
+Unlike `read-variable', which reads only user options, this reads the
+name of any variable. If optional arg REQUIRE-MATCH is nil then it
+reads any symbol, but it provides completion against variable names."
+ (let ((symb (cond ((fboundp 'symbol-nearest-point)
(symbol-nearest-point))
+ ((fboundp 'symbol-at-point)
(symbol-at-point))
+ (t nil)))
+ (enable-recursive-minibuffers t))
+ (when (and default-value (symbolp default-value))
+ (setq default-value (symbol-name default-value)))
+ (intern (completing-read prompt obarray 'boundp require-match nil
'minibuffer-history
+ (let ((var-at-pt (and symb (boundp symb)
(symbol-name symb))))
+ (if (and default-value var-at-pt (>
emacs-major-version 22))
+ (list default-value var-at-pt)
+ (or default-value var-at-pt)))
+ t))))
+
+(defun zz-repeat-command (command)
+ "Repeat COMMAND."
+ (require 'repeat) ;Define its vars before we let-bind them.
+ (let ((repeat-previous-repeated-command command)
+ (repeat-message-function #'ignore)
+ (last-repeatable-command 'repeat))
+ (repeat nil)))
(when (> emacs-major-version 24)
@@ -2417,6 +2409,19 @@ The value of variable `zz-izones' defines the zones."
) ; Emacs 27+
) ; Emacs 25+
+(defun zz-dot-pairs (pairs)
+ "Dot PAIRS, a list of lists, each of which has at least two elements."
+ (mapcar (lambda (b-e) (cons (car b-e) (cadr b-e))) pairs))
+
+(defun zz-dotted-zones-from-izones (&optional variable)
+ "Return a list of dotted zones from value of value of VARIABLE.
+VARIABLE defaults to the value of `zz-izones-var'.
+
+This is similar to an Emacs \"noncontiguous region\" - entry pairs are
+dotted: `(beg . end)', not `(beg end)'. But here the conses of zone
+limits are not united together - they can overlap."
+ (zz-dot-pairs (zz-izone-limits (symbol-value (or variable zz-izones-var)))))
+
(defun zz-noncontiguous-region-from-izones (&optional variable)
"Return a noncontiguous region from value of value of VARIABLE.
VARIABLE defaults to the value of `zz-izones-var'. An Emacs
@@ -2434,10 +2439,6 @@ An Emacs \"noncontiguous region\" (Emacs 25+) is what
the value of
zones, but the entry pairs are dotted: `(beg . end)', not `(beg end)'."
(zz-dot-pairs (zz-zone-union basic-zones)))
-(defun zz-dot-pairs (pairs)
- "Dot PAIRS, a list of lists, each of which has at least two elements."
- (mapcar (lambda (b-e) (cons (car b-e) (cadr b-e))) pairs))
-
(defun zz-overlay-to-zone (overlay &optional pos-type)
"Return a basic zone derived from OVERLAY.
If OVERLAY is not an overlay or it has been deleted (has no buffer)
@@ -2532,6 +2533,90 @@ are included in the returned list."
(push ov new-ovs))) ; Add other-buffer overlays to return
value.
new-ovs))
+(defun zz-izones-from-zones (basic-zones)
+ "Return a list of zones like `zz-izones', based on BASIC-ZONES.
+Each zone in the list BASIC-ZONES has form (LIMIT1 LIMIT2 . EXTRA),
+where each of the limits is a buffer position (a number or marker) and
+EXTRA is a list.
+
+This is a non-destructive operation. A new list is returned.
+
+\(zz-izone-limits (zz-izones-from-zones BASIC-ZONES)) = BASIC-ZONES
+
+Also, (zz-izones-from-zones (zz-izone-limits zz-izones)) returns the
+same set of izones as `zz-izones', but possibly with different IDs
+associated with the basic zones."
+ (let ((ii 0))
+ (nreverse (mapcar (lambda (zz) (cons (- (setq ii (1+ ii))) zz)) (reverse
basic-zones)))))
+
+
+;;(@* "Key Bindings)"
+
+;;; Key Bindings -----------------------------------------------------
+
+;; Put all toggle commands on prefix key `M-='.
+;;
+(defvar zz-toggles-map nil
+ "Keymap containing bindings for toggle commands for zones.")
+(define-prefix-command 'zz-toggles-map)
+
+(defun zz-add-key-bindings-to-narrow-map (bindings)
+ "Add BINDINGS to `narrow-map'.
+\(For Emacs prior to Emacs 24, add bindings to prefix key `C-x n'.)"
+ (let ((map (if (boundp 'narrow-map) narrow-map (lookup-key ctl-x-map "n"))))
+ (when (keymapp map)
+ (dolist (binding bindings)
+ (let ((kseq (car binding))
+ (cmd (cdr binding)))
+ (unless (lookup-key map kseq) (define-key map kseq cmd)))))))
+
+(zz-add-key-bindings-to-narrow-map '(("\M-=" . zz-toggles-map)
+ ("a" . zz-add-zone)
; C-x n a
+ ("A" . zz-add-zone-and-unite)
; C-x n A
+ ("c" . zz-clone-zones)
; C-x n c
+ ("C" . zz-clone-and-unite-zones)
; C-x n C
+ ("\C-d" . zz-delete-zone)
; C-x n C-d
+ ("\C-x" . zz-select-zone-repeat)
; C-x n C-x
+ ("#" . zz-select-zone-by-id-and-text)
; C-x n #
+ ("u" . zz-unite-zones)
; C-x n u
+ ("v" . zz-set-izones-var)
; C-x n v
+ ("x" . zz-narrow-repeat)
; C-x n x
+ ))
+
+(eval-after-load "highlight"
+ '(zz-add-key-bindings-to-narrow-map '(("h" . hlt-highlight-regions)
; C-x n h
+ ("H" .
hlt-highlight-regions-in-buffers) ; C-x n H
+ ("l" . zz-add-zones-from-highlighting)
; C-x n l
+ ("L" . zz-set-zones-from-highlighting)
; C-x n L
+ )))
+
+(eval-after-load "isearch-prop"
+ '(progn
+ (zz-add-key-bindings-to-narrow-map `(("D" . isearchp-remove-dimming)
; C-x n D
+ ("P" .
isearchp-put-prop-on-zones) ; C-x n P
+ ("r" .
zz-add-zones-matching-regexp) ; C-x n r
+ ("R" .
zz-set-zones-matching-regexp) ; C-x n R
+ ("\C-r" . isearchp-zones-backward)
; C-x n C-r
+ ("\C-\M-r" .
isearchp-zones-backward-regexp) ; C-x n C-M-r
+ ("\C-s" . isearchp-zones-forward)
; C-x n C-s
+ ("\C-\M-s" .
isearchp-zones-forward-regexp) ; C-x n C-M-s
+ ("\M-%" . zz-query-replace-zones)
; C-x n M-%
+ (,(kbd "C-M-%") .
zz-query-replace-regexp-zones) ; C-x n C-M-%
+;; ("???" . zz-replace-regexp-zones)
+;; ("???" . zz-replace-string-zones)
+;; ("???" .
zz-map-query-replace-regexp-zones)
+;; ("???" .
isearchp-make-anti-zones-invisible)
+;; ("???" .
isearchp-make-anti-zones-visible)
+;; ("???" .
isearchp-make-zones-invisible)
+;; ("???" . isearchp-make-zones-visible)
+;; ("???" .
isearchp-toggle-zone/anti-zone-visibility)
+ ))
+ (define-key zz-toggles-map (kbd "d")
'isearchp-toggle-dimming-outside-search-area) ; C-x n M-= d
+ (define-key zz-toggles-map (kbd "v")
'isearchp-toggle-anti-zones-invisible) ; C-x n M-= v
+ (define-key zz-toggles-map (kbd "V") 'isearchp-toggle-zones-invisible)
; C-x n M-= V
+ (define-key zz-toggles-map (kbd "~")
'isearchp-toggle-complementing-domain) ; C-x n M-= ~
+ ))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'zones)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/zones 353fc38: Fix Emacs-22 miscompilation,
Stefan Monnier <=