bongo-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [bongo-devel] Marks


From: Daniel Brockman
Subject: Re: [bongo-devel] Marks
Date: Tue, 16 Jan 2007 18:12:49 +0100
User-agent: Gnus/5.11 (Gnus v5.11) Emacs/23.0.51 (gnu/linux)

address@hidden (Daniel Jensen) writes:

> Here's a patch, introducing marks.  I'd appreciate
> your comments.

Cool!  I'm going to apply a modified version of this patch.
It is basically good, but there are some things I would like
done differently, so I just went ahead and changed those.

> I emulated dired where applicable.

Good.

> Currently only track lines can be marked.  For some
> reason I did not think header lines should be marked.

Me neither, so let's keep it that way for now.

> Marking commands:
>
> key             binding
> ---             -------
> m               bongo-mark-line
> u               bongo-unmark-line
> U               bongo-unmark-all-marks

I want to add `DEL' for unmarking backwards, and let's throw
in `M' for marking backwards for symmetry with `t' and `T'.

> % m             bongo-mark-lines-regexp
> % a             bongo-mark-lines-artist-regexp
> % b             bongo-mark-lines-album-regexp
> % t             bongo-mark-lines-track-regexp
> % y             bongo-mark-lines-year-regexp

Those are good, but why not add `% i' for marking by track
index regexp?

Let's also add `% u' for unmarking by regexp match, to go
with `% m', and also `% A', `% B', `% T, `% Y' and `% I' for
unmarking by regexp match against specific fields, to go
with their lowercase variants.

> Commands modified for using marks:
>
> key             binding
> ---             -------
> e               bongo-append-enqueue
> E               bongo-insert-enqueue

Yes, these should prefer to operate on the marked tracks.

> RET             bongo-dwim

I'm not so sure about this one, however.  There is a strong
intuition that RET should operate on whatever is under point.
What if we make `P' always insert-enqueue-play in the library
and play in the playlist (it's unbound now)?  Then one could
use `% m ... RET P' to mark and then play.

> k               bongo-kill-line

Maybe we should make a new command `bongo-kill' that prefers
the marked tracks, if any, or the region, if active, or else
the current line.  That can sit on `k', and `bongo-kill-line'
can stay on `C-k'.

> c               bongo-copy-line-as-kill

Correspondingly, let's make a new command `bongo-copy' that
works on the marked tracks, the region, or the current line.
There's no good key that `bongo-copy-line' (let's rename it)
can stay on, but that's no great loss.

Also, let's take `bongo-kill-region' off of `w' and keep it
only on `C-w'.  That frees up another lowercase key --- yay.

> Yanking killed lines is broken!

I'll take a look at this.

> Customize the display with `bongo-mark-character' and face
> `bongo-marked-line'.

I replaced `bongo-mark-character' with `bongo-mark-format'
and your face with `bongo-marked-track'.  I added a second
face `bongo-marked-track-line' used for the entire line.

[...]

> +(defun bongo-line-marker ()
> +  "Return a new marker for the current line."
> +  (set-marker (make-marker) (bongo-point-at-bol)))
> +
> +(defun bongo-marked-track-line-p ()
> +  "Return non-nil if the line at point is marked."
> +  (member (bongo-line-marker) bongo-marks))

This is wasteful, because you keep allocating new markers.
It's also inefficient, because of the need to perform a
linear search for every call to `bongo-marked-track-line-p'.

Instead, let's put a line property `bongo-marked' on all
marked track lines, so `bongo-marked-track-line-p' can do
its job in constant time.

In fact, let's put the marker object in that line property.
That will be handy when searching the list.

> +(defun bongo-force-visible-line ()
> +  "Expand section headers above if the current line is invisible."
> +  ;; redisplaying an invisible is broken
> +  (while (bongo-before-invisible-text-p)
> +    (save-excursion
> +      (goto-char (bongo-point-before-previous-line-satisfying
> +                  (lambda ()
> +                    (and (bongo-header-line-p)
> +                         (not (bongo-before-invisible-text-p))))))
> +      (bongo-expand))))

This shouldn't be necessary, of course, but maybe it's
desirable to unhide newly-marked tracks anyway?

[...]

> +(defvar bongo-regexp-history nil
> +  "History list of regular expressions used in Bongo commands.")
> +
> +(defun bongo-read-regexp (prompt)
> +  (read-from-minibuffer prompt nil nil nil 'bongo-regexp-history))

Good idea.

> +(defun bongo-mark-lines-regexp (regexp &optional separate-fields)
> +  "Mark lines with fields matching REGEXP.
> +With prefix arg, match fields artist, album and track title
> +separately.  Otherwise, match against a formatted infoset."

Why is the `separate-fields' functionality needed?

[...]

> @@ -4945,14 +5120,22 @@
>  If point is neither on a track nor on a header, do nothing.
>  With numerical prefix argument N, play or enqueue the next N tracks.
>  With \\[universal-argument] as prefix argument in a playlist buffer,
> -  intra-playlist-enqueue the track instead of playing it."
> +  intra-playlist-enqueue the track instead of playing it.
> +If there are marked tracks and the buffer is a library buffer,
> +enqueue the tracks and start playing the first one."
>    (interactive "P")
>    (cond ((and (bongo-track-line-p) (bongo-library-buffer-p))
> -         (let ((position (if (bongo-playing-p)
> -                             (bongo-insert-enqueue-line
> -                              (prefix-numeric-value n))
> -                           (bongo-append-enqueue-line
> -                            (prefix-numeric-value n)))))
> +         (let ((position nil)
> +               (mode (if (bongo-playing-p) 'insert 'append)))
> +           (if bongo-marks
> +               (bongo-process-marks
> +                (lambda ()
> +                  (let ((nextpos (bongo-enqueue-line mode)))
> +                    (setq position (or position nextpos))))
> +                ;; prevent reverse insertion
> +                (when (eq mode 'insert) bongo-marks))
> +             (setq position
> +                   (bongo-enqueue-line mode (prefix-numeric-value n))))
>             (with-bongo-playlist-buffer
>               (bongo-play-line position))))
>          ((and (bongo-track-line-p) (bongo-playlist-buffer-p))

I don't want to do this, because I think it violates
intuition about `RET' (I said this above).


My modified version is not yet ready to be installed ---
it lacks patches to `bongo-kill-line', et al., but the core
functionality and the display code is there.  I'll attach
what I have so far.

diff -rN -u old-bongo/bongo.el new-bongo/bongo.el
--- old-bongo/bongo.el  2007-01-16 18:05:30.000000000 +0100
+++ new-bongo/bongo.el  2007-01-16 18:05:30.000000000 +0100
@@ -452,6 +459,10 @@
   :group 'bongo
   :group 'bongo-file-names)
 
+(defun bongo-format-string (format)
+  "Short for (apply 'concat (mapcar 'eval FORMAT))."
+  (apply 'concat (mapcar 'eval format)))
+
 (defgroup bongo-display nil
   "Display of Bongo playlist and library buffers."
   :group 'bongo)
@@ -630,6 +641,11 @@
   :type 'string
   :group 'bongo-display)
 
+(defcustom bongo-base-indentation-string "  "
+  "String prefixed to all Bongo object lines."
+  :type 'string
+  :group 'bongo-display)
+
 (defcustom bongo-indentation-string "  "
   "String prefixed to lines once for each level of indentation."
   :type 'string
@@ -704,7 +720,7 @@
             (remq 'bongo-header-line-string header-line-format)))
     (setq bongo-header-line-string
           (when (bongo-playing-p)
-            (apply 'concat (mapcar 'eval bongo-header-line-format))))
+            (bongo-format-string bongo-header-line-format)))
     (when (or (equal header-line-format '(""))
               (and (equal header-line-format '("" bongo-header-line-string))
                    (null bongo-header-line-string)))
@@ -1348,8 +1364,7 @@
 Accept DUMMY arguments to ease hook usage."
   (when (bongo-buffer-p)
     (setq bongo-mode-line-indicator-string
-          (apply 'concat
-                 (mapcar 'eval bongo-mode-line-indicator-format)))))
+          (bongo-format-string bongo-mode-line-indicator-format))))
 
 (defun bongo-mode-line-indicator-mode
   (argument &optional called-interactively-p)
@@ -1655,7 +1670,7 @@
                                        'face 'bongo-album-year)))
              (bongo-artist data))
         (if (listp bongo-album-format)
-            (apply 'concat (mapcar 'eval bongo-album-format))
+            (bongo-format-string bongo-album-format)
           ;; XXX: This is deprecated.
           (if (null bongo-year)
               bongo-title
@@ -1674,12 +1689,12 @@
              (bongo-length (bongo-alist-get data 'length))
              (length-string
               (when bongo-length
-                (apply 'concat (mapcar 'eval bongo-track-length-format))))
+                (bongo-format-string bongo-track-length-format)))
              (bongo-length
               (when length-string
                 (propertize length-string 'face 'bongo-track-length))))
         (if (listp bongo-track-format)
-            (apply 'concat (mapcar 'eval bongo-track-format))
+            (bongo-format-string bongo-track-format)
           ;; XXX: This is deprecated.
           (if (null bongo-index)
               bongo-title
@@ -1709,7 +1724,7 @@
                      (t (error (concat "Invalid action description "
                                        "specifier: `%S'")
                                description-specifier))))))
-        (apply 'concat (mapcar 'eval bongo-action-format)))))))
+        (bongo-format-string bongo-action-format))))))
 
 (defun bongo-file-name-part-from-field (field)
   "Represent FIELD as part of a file name.
@@ -2782,7 +2797,7 @@
   ;; `bongo-line-serializable-properties'.
   (list 'bongo-file-name 'bongo-action 'bongo-infoset
         'bongo-fields 'bongo-external-fields
-        'bongo-header 'bongo-collapsed
+        'bongo-header 'bongo-collapsed 'bongo-marked
         'bongo-player 'bongo-played)
   "List of semantic text properties used in Bongo buffers.
 When redisplaying lines, semantic text properties are preserved,
@@ -3055,6 +3070,360 @@
         (bongo-maybe-insert-intermediate-header)))))
 
 
+;;;; Marks
+
+;;; Each track line in Bongo is either marked or unmarked.
+;;; Many commands default to operating on the marked track
+;;; lines whenever the buffer has at least one.
+;;;
+;;; Every marked track line has a `bongo-marked' property
+;;; holding a marker in `bongo-marked-track-line-markers',
+;;; which is a list of markers pointing to the start of
+;;; marked track lines.
+;;;
+;;; The `bongo-marked-track-line-markers' list facilitates
+;;; quickly walking over all marked track lines, but the
+;;; double bookkeeping increases complexity.  (Remember to
+;;; update both the text property and the global list.)
+;;;
+;;; Marks on killed tracks do not persist when yanking the
+;;; tracks back into a Bongo buffer.
+
+(defface bongo-marked-track '((t nil))
+  "Face used for marked Bongo tracks."
+  :group 'bongo-faces)
+
+(defface bongo-marked-track-line
+  '((t (:inherit fringe)))
+  "Face used for lines of marked Bongo tracks."
+  :group 'bongo-faces)
+
+(defcustom bongo-mark-format '("* ")
+  "Template for displaying marks in Bongo.
+Value is a list of expressions, each evaluating to a string or nil.
+The values of the expressions are concatenated."
+  :type '(repeat sexp)
+  :group 'bongo-display)
+
+(defvar bongo-marked-track-line-markers nil
+  "List of markers pointing at marked track lines.
+Bongo track lines can be `marked' or `unmarked'; this is a
+high-level Bongo concept, not to be confused with `markers',
+the primitive Emacs objects used to mark buffer positions.")
+(make-variable-buffer-local 'bongo-marked-track-line-markers)
+
+(defun bongo-marked-track-line-p (&optional point)
+  "Return non-nil if the line at POINT is a marked track line."
+  (not (null (bongo-line-get-property 'bongo-marked point))))
+
+(defun bongo-unmarked-track-line-p (&optional point)
+  "Return non-nil if the line at POINT is an unmarked track line."
+  (and (bongo-track-line-p point)
+       (not (bongo-marked-track-line-p point))))
+
+(defun bongo-mark-line (&optional point)
+  "Mark the track or section at POINT.
+Marking a section just marks all tracks in that section."
+  (cond ((bongo-header-line-p point)
+         (bongo-mark-region (bongo-point-before-next-line point)
+                            (bongo-point-after-object point)))
+        ((bongo-unmarked-track-line-p point)
+         (let ((marker (move-marker (make-marker)
+                                    (bongo-point-at-bol point))))
+           (bongo-line-set-property 'bongo-marked marker point)
+           (push marker bongo-marked-track-line-markers))
+         (bongo-redisplay-line point))))
+
+(defun bongo-mark-line-forward (&optional n)
+  "Mark the next N tracks or sections.
+Marking a section just marks all tracks in that section.
+Leave point after the marked tracks."
+  (interactive "p")
+  (if (< n 0)
+      (bongo-mark-line-backward (- n))
+    (dotimes (dummy n)
+      (bongo-snap-to-object-line)
+      (bongo-mark-line)
+      (goto-char (bongo-point-after-object)))))
+
+(defun bongo-mark-line-backward (&optional n)
+  "Mark the previous N tracks or sections.
+Marking a section just marks all tracks in that section.
+Leave point at the topmost affected track."
+  (interactive "p")
+  (if (< n 0)
+      (bongo-mark-line-forward (- n))
+    (dotimes (dummy n)
+      (bongo-previous-object)
+      (bongo-mark-line))))
+
+(defun bongo-mark-region (beg end)
+  "Mark all tracks in the region."
+  (interactive "r")
+  (save-excursion
+    (goto-char beg)
+    (while (progn (bongo-snap-to-object-line 'no-error)
+                  (< (point) end))
+      (bongo-mark-line)
+      (goto-char (bongo-point-after-object)))))
+
+(defun bongo-mark-forward (&optional n)
+  "Mark the next N tracks or sections.
+If the region is active, ignore N and mark the region instead.
+See `bongo-mark-line-forward' and `bongo-mark-region'."
+  (interactive "p")
+  (if (bongo-region-active-p)
+      (bongo-mark-region (region-beginning) (region-end))
+    (bongo-mark-line-forward n)))
+
+(defun bongo-mark-backward (&optional n)
+  "Mark the previous N tracks or sections.
+If the region is active, ignore N and mark the region instead.
+See `bongo-mark-line-backward' and `bongo-mark-region'."
+  (interactive "p")
+  (if (bongo-region-active-p)
+      (bongo-mark-region (region-beginning) (region-end))
+    (bongo-mark-line-backward n)))
+
+(defun bongo-unmark-line (&optional point)
+  "Unmark the track or section at POINT.
+Unmarking a section unmarks all tracks in that section."
+  (cond ((bongo-header-line-p point)
+         (bongo-unmark-region (bongo-point-before-next-line point)
+                              (bongo-point-after-object point)))
+        ((bongo-marked-track-line-p point)
+         (setq bongo-marked-track-line-markers
+               (delete (bongo-line-get-property 'bongo-marked)
+                       bongo-marked-track-line-markers))
+         (bongo-line-remove-property 'bongo-marked point)
+         (bongo-redisplay-line point))))
+
+(defun bongo-unmark-line-forward (&optional n)
+  "Unmark the next N tracks or sections.
+Unmarking a section unmarks all tracks in that section.
+Leave point after the affected tracks."
+  (interactive "p")
+  (if (< n 0)
+      (bongo-unmark-line-backward (- n))
+    (dotimes (dummy n)
+      (bongo-snap-to-object-line)
+      (bongo-unmark-line)
+      (goto-char (bongo-point-after-object)))))
+
+(defun bongo-unmark-line-backward (&optional n)
+  "Unmark the previous N tracks or sections.
+Unmarking a section unmarks all tracks in that section.
+Leave point at the topmost affected track."
+  (interactive "p")
+  (if (< n 0)
+      (bongo-unmark-line-forward (- n))
+    (dotimes (dummy n)
+      (bongo-previous-object)
+      (bongo-unmark-line))))
+
+(defun bongo-unmark-region (beg end)
+  "Unmark all tracks in the region."
+  (interactive "r")
+  (save-excursion
+    (goto-char beg)
+    (while (progn (bongo-snap-to-object-line 'no-error)
+                  (< (point) end))
+      (bongo-unmark-line)
+      (goto-char (bongo-point-after-object)))))
+
+(defun bongo-unmark-forward (&optional n)
+  "Unmark the next N tracks or sections.
+If the region is active, ignore N and unmark the region instead.
+See `bongo-unmark-line-forward' and `bongo-unmark-region'."
+  (interactive "p")
+  (if (bongo-region-active-p)
+      (bongo-unmark-region (region-beginning) (region-end))
+    (bongo-unmark-line-forward n)))
+
+(defun bongo-unmark-backward (&optional n)
+  "Unmark the previous N tracks or sections.
+If the region is active, ignore N and unmark the region instead.
+See `bongo-unmark-line-backward' and `bongo-unmark-region'."
+  (interactive "p")
+  (if (bongo-region-active-p)
+      (bongo-unmark-region (region-beginning) (region-end))
+    (bongo-unmark-line-backward n)))
+
+(defun bongo-mark-all-tracks ()
+  "Mark all tracks in the current buffer."
+  (interactive)
+  (bongo-mark-region (point-min) (point-max)))
+
+(defun bongo-unmark-all-tracks ()
+  "Unmark all tracks in the current buffer."
+  (interactive)
+  (let ((markers bongo-marked-track-line-markers))
+    (setq bongo-marked-track-line-markers nil)
+    (save-excursion
+      (dolist (marker markers)
+        (goto-char marker)
+        (bongo-unmark-line)))))
+
+(defun bongo-mark-track-lines-satisfying (predicate)
+  "Mark all track lines satisfying PREDICATE.
+Return the number of newly-marked tracks."
+  (let ((count 0))
+    (save-excursion
+      (goto-char (point-min))
+      (while (and (not (eobp))
+                  (bongo-snap-to-object-line 'no-error))
+        (unless (bongo-marked-track-line-p)
+          (when (funcall predicate)
+            (bongo-mark-line)
+            (setq count (+ count 1))))
+        (goto-char (bongo-point-after-line))))
+    count))
+
+(defun bongo-unmark-track-lines-satisfying (predicate)
+  "Unmark all track lines satisfying PREDICATE.
+Return the number of newly-unmarked tracks."
+  (let ((count 0))
+    (save-excursion
+      (dolist (marker bongo-marked-track-line-markers)
+        (goto-char marker)
+        (when (funcall predicate)
+          (bongo-unmark-line)
+          (setq count (+ count 1)))))
+    count))
+
+(defun bongo-mark-by-regexp (regexp key-function)
+  "Mark all track lines for which KEY-FUNCTION's value matches REGEXP.
+Do not mark lines for which KEY-FUNCTION returns nil.
+Return the number of newly-marked tracks."
+  (let* ((previously-marked-track-lines bongo-marked-track-line-markers)
+         (count (bongo-mark-track-lines-satisfying
+                 (lambda ()
+                   (let ((key (funcall key-function)))
+                     (and key (string-match regexp key)))))))
+    (if previously-marked-track-lines
+        (if (zerop count)
+            (message "Marked no additional tracks.")
+          (message "Marked %d additional track%s." count
+                   (if (= count 1) "" "s")))
+      (if (zerop count)
+          (message "No matching tracks.")
+        (message "Marked %d track%s." count
+                 (if (= count 1) "" "s"))))
+    count))
+
+(defun bongo-unmark-by-regexp (regexp key-function)
+  "Unmark all track lines for which KEY-FUNCTION's value matches REGEXP.
+Do not unmark lines for which KEY-FUNCTION returns nil.
+Return the number of newly-unmarked tracks."
+  (if (null bongo-marked-track-line-markers)
+      (message "No marked tracks.")
+    (let ((count (bongo-unmark-track-lines-satisfying
+                  (lambda ()
+                    (let ((key (funcall key-function)))
+                      (and key (string-match regexp key)))))))
+      (if (zerop count)
+          (message "No matching marked tracks.")
+        (message "Unmarked %d track%s." count
+                 (if (= count 1) "" "s")))
+      count)))
+
+(defun bongo-mark-by-formatted-infoset-regexp (regexp)
+  "Mark all lines whose formatted infoset matches REGEXP.
+Return the number of newly-marked tracks."
+  (interactive "sMark by regexp: ")
+  (bongo-mark-by-regexp regexp (lambda ()
+                                 (bongo-format-infoset
+                                  (bongo-line-infoset)))))
+
+(defun bongo-mark-by-artist-name-regexp (regexp)
+  "Mark all lines whose artist name matches REGEXP.
+Return the number of newly-marked tracks."
+  (interactive "sMark by artist name (regexp): ")
+  (bongo-mark-by-regexp regexp (lambda ()
+                                 (bongo-infoset-artist-name
+                                  (bongo-line-infoset)))))
+
+(defun bongo-mark-by-album-title-regexp (regexp)
+  "Mark all lines whose album title matches REGEXP.
+Return the number of newly-marked tracks."
+  (interactive "sMark by album title (regexp): ")
+  (bongo-mark-by-regexp regexp (lambda ()
+                                 (bongo-infoset-album-title
+                                  (bongo-line-infoset)))))
+
+(defun bongo-mark-by-album-year-regexp (regexp)
+  "Mark all lines whose album year matches REGEXP.
+Return the number of newly-marked tracks."
+  (interactive "sMark by album year (regexp): ")
+  (bongo-mark-by-regexp regexp (lambda ()
+                                 (bongo-infoset-album-year
+                                  (bongo-line-infoset)))))
+
+(defun bongo-mark-by-track-index-regexp (regexp)
+  "Mark all lines whose track index matches REGEXP.
+Return the number of newly-marked tracks."
+  (interactive "sMark by track index (regexp): ")
+  (bongo-mark-by-regexp regexp (lambda ()
+                                 (bongo-infoset-track-index
+                                  (bongo-line-infoset)))))
+
+(defun bongo-mark-by-track-title-regexp (regexp)
+  "Mark all lines whose track title matches REGEXP.
+Return the number of newly-marked tracks."
+  (interactive "sMark by track title (regexp): ")
+  (bongo-mark-by-regexp regexp (lambda ()
+                                 (bongo-infoset-track-title
+                                  (bongo-line-infoset)))))
+
+(defun bongo-unmark-by-formatted-infoset-regexp (regexp)
+  "Unmark all lines whose formatted infoset matches REGEXP.
+Return the number of newly-unmarked tracks."
+  (interactive "sUnmark by regexp: ")
+  (bongo-unmark-by-regexp regexp (lambda ()
+                                   (bongo-format-infoset
+                                    (bongo-line-infoset)))))
+
+(defun bongo-unmark-by-artist-name-regexp (regexp)
+  "Unmark all lines whose artist name matches REGEXP.
+Return the number of newly-unmarked tracks."
+  (interactive "sUnmark by artist name (regexp): ")
+  (bongo-unmark-by-regexp regexp (lambda ()
+                                   (bongo-infoset-artist-name
+                                    (bongo-line-infoset)))))
+
+(defun bongo-unmark-by-album-title-regexp (regexp)
+  "Unmark all lines whose album title matches REGEXP.
+Return the number of newly-unmarked tracks."
+  (interactive "sUnmark by album title (regexp): ")
+  (bongo-unmark-by-regexp regexp (lambda ()
+                                   (bongo-infoset-album-title
+                                    (bongo-line-infoset)))))
+
+(defun bongo-unmark-by-album-year-regexp (regexp)
+  "Unmark all lines whose album year matches REGEXP.
+Return the number of newly-unmarked tracks."
+  (interactive "sUnmark by album year (regexp): ")
+  (bongo-unmark-by-regexp regexp (lambda ()
+                                   (bongo-infoset-album-year
+                                    (bongo-line-infoset)))))
+
+(defun bongo-unmark-by-track-index-regexp (regexp)
+  "Unmark all lines whose track index matches REGEXP.
+Return the number of newly-unmarked tracks."
+  (interactive "sUnmark by track index (regexp): ")
+  (bongo-unmark-by-regexp regexp (lambda ()
+                                   (bongo-infoset-track-index
+                                    (bongo-line-infoset)))))
+
+(defun bongo-unmark-by-track-title-regexp (regexp)
+  "Unmark all lines whose track title matches REGEXP.
+Return the number of newly-unmarked track lines."
+  (interactive "sUnmark by track title (regexp): ")
+  (bongo-unmark-by-regexp regexp (lambda ()
+                                   (bongo-infoset-track-title
+                                    (bongo-line-infoset)))))
+
+
 ;;;; Backends
 
 (defun bongo-backend (backend-name)
@@ -6481,20 +6850,54 @@
 
 ;;;; Displaying
 
-(defun bongo-facify (string &rest new-faces)
-  "Add NEW-FACES to the `face' property of STRING.
-For each character in STRING, if the value of the `face' property is
-a list, append NEW-FACES to the old value and make that the new value.
-If the value is a symbol, treat it as if it were a singleton list."
-  (prog1 string
-    (let ((index 0))
-      (while index
-        (let ((next-index (next-single-property-change index 'face string))
-              (old-faces (get-text-property index 'face string)))
-          (put-text-property index (or next-index (length string))
-                             'face (append new-faces old-faces) string)
+(defvar bongo-facify-below-existing-faces nil
+  "When non-nil, existing faces take priority over new faces.
+When nil, new faces take priority over any existing faces.
+This variable controls the behavior of `bongo-facify-in-object'.")
+
+(defun bongo-facify-in-object (beg end object &rest new-faces)
+  "Add NEW-FACES to the `face' property between BEG and END in OBJECT.
+For each character between BEG and END in OBJECT, if the value
+  of the `face' property is a list, append NEW-FACES to the old
+  value and make that the new value; if the value is a symbol,
+  treat it as if it were a singleton list.
+Return OBJECT, which may be a string or a buffer."
+  (prog1 object
+    (let ((index beg))
+      (while (and index (< index end))
+        (let* ((next-index (next-single-property-change index 'face object))
+               (segment-end (min (or next-index end) end))
+               (old-face-property (get-text-property index 'face object))
+               (old-faces (if (listp old-face-property)
+                              old-face-property
+                            (list old-face-property)))
+               (faces (if bongo-facify-below-existing-faces
+                          (append old-faces new-faces)
+                        (append new-faces old-faces))))
+          (put-text-property index segment-end 'face faces object)
           (setq index next-index))))))
 
+(defun bongo-facify-string (string &rest new-faces)
+  "Add NEW-FACES to the `face' property of STRING.
+This function calls `bongo-facify-in-object'."
+  (apply 'bongo-facify-in-object 0 (length string) string new-faces))
+
+(defalias 'bongo-facify 'bongo-facify-string)
+
+(defun bongo-facify-region (beg end &rest new-faces)
+  "Add NEW-FACES to the `face' property of text between BEG and END.
+This function calls `bongo-facify-in-object' on the current buffer."
+  (apply 'bongo-facify-in-object beg end (current-buffer) new-faces))
+
+(defun bongo-facify-current-line (&rest new-faces)
+  "Add NEW-FACES to the `face' property of the current line.
+This function calls `bongo-facify-region' on the current line,
+including the terminating newline character."
+  (apply 'bongo-facify-region
+         (bongo-point-before-line)
+         (bongo-point-after-line)
+         new-faces))
+
 (defun bongo-redisplay-line (&optional point)
   "Redisplay the line at POINT, preserving semantic text properties."
   (bongo-goto-point point)
@@ -6508,28 +6911,42 @@
         (invisible (bongo-line-get-property 'invisible))
         (currently-playing (bongo-currently-playing-track-line-p))
         (played (bongo-played-track-line-p))
+        (marked (bongo-marked-track-line-p))
         (properties (bongo-line-get-semantic-properties)))
     (save-excursion
       (bongo-clear-line)
       (bongo-line-set-properties properties)
+      (insert bongo-base-indentation-string)
       (dotimes (dummy indentation)
         (insert bongo-indentation-string))
+      (when marked
+        (goto-char (point-at-bol))
+        (let ((mark-string (bongo-format-string bongo-mark-format)))
+          (insert mark-string)
+          (delete-char (min (length mark-string)
+                            (- (point-at-eol) (point)))))
+        (goto-char (point-at-eol)))
       (let* ((bongo-infoset-formatting-target
               (current-buffer))
              (bongo-infoset-formatting-target-line
               (bongo-point-before-line))
-             (content (apply 'propertize (bongo-format-infoset infoset)
-                             'follow-link t 'mouse-face 'highlight
-                             (when invisible
-                               (list 'invisible invisible)))))
-        (insert
-         (cond (header
-                (bongo-format-header content collapsed))
-               (currently-playing
-                (bongo-facify content 'bongo-currently-playing-track))
-               (played
-                (bongo-facify content 'bongo-played-track))
-               (t content)))))))
+             (content
+              (apply 'propertize (bongo-format-infoset infoset)
+                     'follow-link t 'mouse-face 'highlight
+                     (when invisible
+                       (list 'invisible invisible)))))
+        (if header
+            (setq content (bongo-format-header content collapsed))
+          (cond (currently-playing
+                 (bongo-facify content 'bongo-currently-playing-track))
+                (played
+                 (bongo-facify content 'bongo-played-track)))
+          (cond (marked
+                 (bongo-facify content 'bongo-marked-track))))
+        (insert content))
+      (when marked
+        (let ((bongo-facify-below-existing-faces t))
+          (bongo-facify-current-line 'bongo-marked-track-line))))))
 
 (defun bongo-redisplay-region (beg end)
   "Redisplay the Bongo objects in the region between BEG and END."
@@ -7345,6 +7762,26 @@
     (define-key map "T" 'bongo-transpose-backward)
     (define-key map "f" 'bongo-flush-playlist)
     (define-key map "F" 'bongo-reset-playlist)
+    (define-key map "m" 'bongo-mark-forward)
+    (define-key map "M" 'bongo-mark-backward)
+    (define-key map "u" 'bongo-unmark-forward)
+    (define-key map "\177" 'bongo-unmark-backward)
+    (substitute-key-definition
+     'backward-delete-char 'bongo-unmark-backward map global-map)
+    (define-key map "U" 'bongo-unmark-all-tracks)
+    (define-key map "%" nil)            ; For Emacs 21.
+    (define-key map "%m" 'bongo-mark-by-formatted-infoset-regexp)
+    (define-key map "%u" 'bongo-unmark-by-formatted-infoset-regexp)
+    (define-key map "%a" 'bongo-mark-by-artist-name-regexp)
+    (define-key map "%b" 'bongo-mark-by-album-title-regexp)
+    (define-key map "%y" 'bongo-mark-by-album-year-regexp)
+    (define-key map "%i" 'bongo-mark-by-track-index-regexp)
+    (define-key map "%t" 'bongo-mark-by-track-title-regexp)
+    (define-key map "%A" 'bongo-unmark-by-artist-name-regexp)
+    (define-key map "%B" 'bongo-unmark-by-album-title-regexp)
+    (define-key map "%Y" 'bongo-unmark-by-album-year-regexp)
+    (define-key map "%I" 'bongo-unmark-by-track-index-regexp)
+    (define-key map "%T" 'bongo-unmark-by-track-title-regexp)
     (define-key map "r" 'bongo-rename-line)
     (define-key map "d" 'bongo-dired-line)
     (when (require 'volume nil t)
@@ -7662,7 +8099,7 @@
   To insert a whole directory tree, use `i t'.
   To insert the URL of a media file or stream, use `i u'.
 
-  To enqueue tracks in the playlist buffer, use `e'.
+  To enqueue tracks in the nearest playlist buffer, use `e'.
   To hop to the nearest playlist buffer, use `h'.\n\n"))
             (when bongo-prefer-library-buffers
               (bongo-insert-enabled-backends-comment)))))))

Thanks for starting the work on this, Daniel, and thanks for
suggesting it, Romain.  I'll have it installed soon. :-)


-- 
Daniel Brockman <address@hidden>

reply via email to

[Prev in Thread] Current Thread [Next in Thread]