Mercurial > emacs

changeset 107559:9ba820e1741a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge from mainline.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Thu, 25 Mar 2010 00:17:24 +0000
parents 20d30f421e4b (current diff) d59e6301c2cd (diff)
children 9ffe3226fad6
files
diffstat 4 files changed, 143 insertions(+), 130 deletions(-) [+]
line wrap: on
line diff
--- a/etc/NEWS	Wed Mar 24 21:57:06 2010 +0000
+++ b/etc/NEWS	Thu Mar 25 00:17:24 2010 +0000
@@ -45,6 +45,7 @@
 
 * Changes in Specialized Modes and Packages in Emacs 24.1
 
+** mpc.el: Can use pseudo tags of the form tag1|tag2 as a union of two tags.
 ** Customize
 
 *** Customize buffers now contain a search field.
--- a/lisp/ChangeLog	Wed Mar 24 21:57:06 2010 +0000
+++ b/lisp/ChangeLog	Thu Mar 25 00:17:24 2010 +0000
@@ -1,5 +1,27 @@
+2010-03-25  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	Add "union tags" in mpc.el.
+	* mpc.el: Remove backward compatibility code.
+	(mpc-browser-tags): Change default.
+	(mpc--find-memoize-union-tags): New var.
+	(mpc-cmd-flush, mpc-cmd-special-tag-p): New fun.
+	(mpc-cmd-find): Handle the case where the playlist does not exist.
+	Handle union-tags.
+	(mpc-cmd-list): Use mpc-cmd-special-tag-p.  Handle union-tags.
+	(mpc-cmd-add): Use mpc-cmd-flush.
+	(mpc-tagbrowser-tag-name): New fun.
+	(mpc-tagbrowser-buf): Use it.
+	(mpc-songs-refresh): Use cond.  Move to point-min as a fallback.
+
 2010-03-24  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	Misc cleanup.
+	* progmodes/make-mode.el (makefile-bsdmake-rule-action-regex):
+	Use replace-regexp-in-string.
+	(makefile-mode-abbrev-table): Merge defvar and define-abbrev-table.
+	(makefile-imake-mode-syntax-table): Move init into defvar.
+	(makefile-mode): Use define-derived-mode.
+
 	* progmodes/make-mode.el (makefile-rule-action-regex): Backtrack less.
 	(makefile-make-font-lock-keywords): Adjust rule since submatch 1 may
 	not be present any more.
--- a/lisp/mpc.el	Wed Mar 24 21:57:06 2010 +0000
+++ b/lisp/mpc.el	Thu Mar 25 00:17:24 2010 +0000
@@ -94,54 +94,17 @@
 
 (eval-when-compile (require 'cl))
 
-;;; Backward compatibility.
-;; This code is meant for Emacs-CVS, so to get it to run on anything else,
-;; we need to define some more things.
-
-(unless (fboundp 'tool-bar-local-item)
-  (defun tool-bar-local-item (icon def key map &rest props)
-    (define-key-after map (vector key)
-      `(menu-item ,(symbol-name key) ,def
-                  :image ,(find-image
-                           `((:type xpm :file ,(concat icon ".xpm"))))
-                  ,@props))))
-
-(unless (fboundp 'process-put)
-  (defconst mpc-process-hash (make-hash-table :weakness 'key))
-  (defun process-put (proc prop val)
-    (let ((sym (gethash proc mpc-process-hash)))
-      (unless sym
-        (setq sym (puthash proc (make-symbol "mpc-proc-sym") mpc-process-hash)))
-      (put sym prop val)))
-  (defun process-get (proc prop)
-    (let ((sym (gethash proc mpc-process-hash)))
-      (when sym (get sym prop))))
-  (defun process-plist (proc)
-    (let ((sym (gethash proc mpc-process-hash)))
-      (when sym (symbol-plist sym)))))
-(unless (fboundp 'with-local-quit)
-  (defmacro with-local-quit (&rest body)
-    `(condition-case nil (let ((inhibit-quit nil)) ,@body)
-       (quit (setq quit-flag t) nil))))
-(unless (fboundp 'balance-windows-area)
-  (defalias 'balance-windows-area 'balance-windows))
-(unless (fboundp 'posn-object) (defalias 'posn-object 'ignore))
-(unless (fboundp 'buffer-local-value)
-  (defun buffer-local-value (var buf)
-    (with-current-buffer buf (symbol-value var))))
-
-
-;;; Main code starts here.
-
 (defgroup mpc ()
   "A Client for the Music Player Daemon."
   :prefix "mpc-"
   :group 'multimedia
   :group 'applications)
 
-(defcustom mpc-browser-tags '(Genre Artist Album Playlist)
+(defcustom mpc-browser-tags '(Genre Artist|Composer|Performer
+                              Album|Playlist)
   "Tags for which a browser buffer should be created by default."
-  :type '(repeat string))
+  ;; FIXME: provide a list of tags, for completion.
+  :type '(repeat symbol))
 
 ;;; Misc utils ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -620,6 +583,19 @@
 ;;                       (mpc--queue-head)))
 ;;           (message "MPC's queue is out of sync"))))))
 
+(defvar mpc--find-memoize-union-tags nil)
+
+(defun mpc-cmd-flush (tag value)
+  (puthash (cons tag value) nil mpc--find-memoize)
+  (dolist (uniontag mpc--find-memoize-union-tags)
+    (if (member (symbol-name tag) (split-string (symbol-name uniontag) "|"))
+        (puthash (cons uniontag value) nil mpc--find-memoize))))
+
+
+(defun mpc-cmd-special-tag-p (tag)
+  (or (memq tag '(Playlist Search Directory))
+      (string-match "|" (symbol-name tag))))
+
 (defun mpc-cmd-find (tag value)
   "Return a list of all songs whose tag TAG has value VALUE.
 The songs are returned as alists."
@@ -628,8 +604,12 @@
                (cond
                 ((eq tag 'Playlist)
                  ;; Special case for pseudo-tag playlist.
-                 (let ((l (mpc-proc-buf-to-alists
-                           (mpc-proc-cmd (list "listplaylistinfo" value))))
+                 (let ((l (condition-case err
+                              (mpc-proc-buf-to-alists
+                               (mpc-proc-cmd (list "listplaylistinfo" value)))
+                            (mpc-proc-error
+                             ;; "[50@0] {listplaylistinfo} No such playlist"
+                             nil)))
                        (i 0))
                    (mapcar (lambda (s)
                              (prog1 (cons (cons 'Pos (number-to-string i)) s)
@@ -648,6 +628,14 @@
                                         (if (eq (car pair) 'directory)
                                             nil pair))
                                       pairs)))))
+                ((string-match "|" (symbol-name tag))
+                 (add-to-list 'mpc--find-memoize-union-tags tag)
+                 (let ((tag1 (intern (substring (symbol-name tag)
+                                                0 (match-beginning 0))))
+                       (tag2 (intern (substring (symbol-name tag)
+                                                (match-end 0)))))
+                   (mpc-union (mpc-cmd-find tag1 value)
+                              (mpc-cmd-find tag2 value))))
                 (t
                  (condition-case err
                      (mpc-proc-buf-to-alists
@@ -675,7 +663,7 @@
       (when other-tag
         (dolist (pl (prog1 pls (setq pls nil)))
           (let ((plsongs (mpc-cmd-find 'Playlist pl)))
-            (if (not (member other-tag '(Playlist Search Directory)))
+            (if (not (mpc-cmd-special-tag-p other-tag))
                 (when (member (cons other-tag value)
                               (apply 'append plsongs))
                   (push pl pls))
@@ -743,6 +731,14 @@
    ;; useful that would be tho.
    ((eq tag 'Search) (error "Not supported"))
 
+   ((string-match "|" (symbol-name tag))
+    (let ((tag1 (intern (substring (symbol-name tag)
+                                   0 (match-beginning 0))))
+          (tag2 (intern (substring (symbol-name tag)
+                                   (match-end 0)))))
+      (mpc-union (mpc-cmd-list tag1 other-tag value)
+                 (mpc-cmd-list tag2 other-tag value))))
+
    ((null other-tag)
     (condition-case nil
         (mapcar 'cdr (mpc-proc-cmd-to-alist (list "list" (symbol-name tag))))
@@ -754,7 +750,7 @@
        (mpc-assq-all tag (mpc-proc-cmd-to-alist "listallinfo")))))
    (t
     (condition-case nil
-        (if (member other-tag '(Search Playlist Directory))
+        (if (mpc-cmd-special-tag-p other-tag)
             (signal 'mpc-proc-error "Not implemented")
           (mapcar 'cdr
                   (mpc-proc-cmd-to-alist
@@ -801,7 +797,7 @@
                              (list "add" file)))
                          files)))
     (if (stringp playlist)
-        (puthash (cons 'Playlist playlist) nil mpc--find-memoize)))
+        (mpc-cmd-flush 'Playlist playlist)))
 
 (defun mpc-cmd-delete (song-poss &optional playlist)
   "Delete the songs at positions SONG-POSS from PLAYLIST.
@@ -928,6 +924,10 @@
 ;;; Formatter ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun mpc-secs-to-time (secs)
+  ;; We could use `format-seconds', but it doesn't seem worth the trouble
+  ;; because we'd still need to check (>= secs (* 60 100)) since the special
+  ;; %z only allows us to drop the large units for small values but
+  ;; not to drop the small units for large values.
   (if (stringp secs) (setq secs (string-to-number secs)))
   (if (>= secs (* 60 100))              ;More than 100 minutes.
       (format "%dh%02d" ;"%d:%02d:%02d"
@@ -1432,6 +1432,20 @@
         (with-current-buffer buf (with-local-quit (mpc-tagbrowser-refresh)))))
     (with-local-quit (mpc-songs-refresh))))
 
+(defun mpc-tagbrowser-tag-name (tag)
+  (cond
+   ((string-match "|" (symbol-name tag))
+    (let ((tag1 (intern (substring (symbol-name tag)
+                                   0 (match-beginning 0))))
+          (tag2 (intern (substring (symbol-name tag)
+                                   (match-end 0)))))
+      (concat (mpc-tagbrowser-tag-name tag1)
+              " | "
+              (mpc-tagbrowser-tag-name tag2))))
+   ((string-match "y\\'" (symbol-name tag))
+    (concat (substring (symbol-name tag) 0 -1) "ies"))
+   (t (concat (symbol-name tag) "s"))))
+
 (defun mpc-tagbrowser-buf (tag)
   (let ((buf (mpc-proc-buffer (mpc-proc) tag)))
     (if (buffer-live-p buf) buf
@@ -1446,10 +1460,7 @@
           (insert mpc-tagbrowser-all-name "\n"))
         (forward-line -1)
         (setq mpc-tag tag)
-        (setq mpc-tag-name
-              (if (string-match "y\\'" (symbol-name tag))
-                  (concat (substring (symbol-name tag) 0 -1) "ies")
-                (concat (symbol-name tag) "s")))
+        (setq mpc-tag-name (mpc-tagbrowser-tag-name tag))
         (mpc-tagbrowser-all-select)
         (mpc-tagbrowser-refresh)
         buf))))
@@ -1858,20 +1869,22 @@
                                  (mapcar (lambda (val)
                                            (mpc-cmd-find (car cst) val))
                                          (cdr cst)))))
-                (setq active (if (null active)
-                                 (progn
+                (setq active (cond
+                              ((null active)
                                    (if (eq (car cst) 'Playlist)
                                        (setq dontsort t))
                                    vals)
-                               (if (or dontsort
+                              ((or dontsort
                                        ;; Try to preserve ordering and
                                        ;; repetitions from playlists.
                                        (not (eq (car cst) 'Playlist)))
                                    (mpc-intersection active vals
-                                                     (lambda (x) (assq 'file x)))
+                                                 (lambda (x) (assq 'file x))))
+                              (t
                                  (setq dontsort t)
                                  (mpc-intersection vals active
-                                                   (lambda (x) (assq 'file x)))))))))
+                                                 (lambda (x)
+                                                   (assq 'file x)))))))))
           (mpc-select-save
             (erase-buffer)
             ;; Sorting songs is surprisingly difficult: when comparing two
@@ -1902,9 +1915,10 @@
               ))
           (goto-char (point-min))
           (forward-line (car curline))
-          (when (or (search-forward (cdr curline) nil t)
+          (if (or (search-forward (cdr curline) nil t)
                     (search-backward (cdr curline) nil t))
-            (beginning-of-line))
+              (beginning-of-line)
+            (goto-char (point-min)))
           (set (make-local-variable 'mpc-songs-totaltime)
                (unless (zerop totaltime)
                  (list " " (mpc-secs-to-time totaltime))))
--- a/lisp/progmodes/make-mode.el	Wed Mar 24 21:57:06 2010 +0000
+++ b/lisp/progmodes/make-mode.el	Thu Mar 25 00:17:24 2010 +0000
@@ -281,8 +281,7 @@
   "Regex used to highlight makepp rule action lines in font lock mode.")
 
 (defconst makefile-bsdmake-rule-action-regex
-  (progn (string-match "-@" makefile-rule-action-regex)
-	 (replace-match "-+@" t t makefile-rule-action-regex))
+  (replace-regexp-in-string "-@" "-+@" makefile-rule-action-regex)
   "Regex used to highlight BSD rule action lines in font lock mode.")
 
 ;; Note that the first and second subexpression is used by font lock.  Note
@@ -521,25 +520,25 @@
     ("Macro Assignment" ,makefile-macroassign-regex 1))
   "Imenu generic expression for Makefile mode.  See `imenu-generic-expression'.")
 
-;;; ------------------------------------------------------------
-;;; The following configurable variables are used in the
-;;; up-to-date overview .
-;;; The standard configuration assumes that your `make' program
-;;; can be run in question/query mode using the `-q' option, this
-;;; means that the command
-;;;
-;;;    make -q foo
-;;;
-;;; should return an exit status of zero if the target `foo' is
-;;; up to date and a nonzero exit status otherwise.
-;;; Many makes can do this although the docs/manpages do not mention
-;;; it. Try it with your favourite one.  GNU make, System V make, and
-;;; Dennis Vadura's DMake have no problems.
-;;; Set the variable `makefile-brave-make' to the name of the
-;;; make utility that does this on your system.
-;;; To understand what this is all about see the function definition
-;;; of `makefile-query-by-make-minus-q' .
-;;; ------------------------------------------------------------
+;; ------------------------------------------------------------
+;; The following configurable variables are used in the
+;; up-to-date overview .
+;; The standard configuration assumes that your `make' program
+;; can be run in question/query mode using the `-q' option, this
+;; means that the command
+;;
+;;    make -q foo
+;;
+;; should return an exit status of zero if the target `foo' is
+;; up to date and a nonzero exit status otherwise.
+;; Many makes can do this although the docs/manpages do not mention
+;; it. Try it with your favourite one.  GNU make, System V make, and
+;; Dennis Vadura's DMake have no problems.
+;; Set the variable `makefile-brave-make' to the name of the
+;; make utility that does this on your system.
+;; To understand what this is all about see the function definition
+;; of `makefile-query-by-make-minus-q' .
+;; ------------------------------------------------------------
 
 (defcustom makefile-brave-make "make"
   "*How to invoke make, for `makefile-query-targets'.
@@ -574,11 +573,8 @@
 
 ;;; --- end of up-to-date-overview configuration ------------------
 
-(defvar makefile-mode-abbrev-table nil
+(define-abbrev-table 'makefile-mode-abbrev-table ()
   "Abbrev table in use in Makefile buffers.")
-(if makefile-mode-abbrev-table
-    ()
-  (define-abbrev-table 'makefile-mode-abbrev-table ()))
 
 (defvar makefile-mode-map
   (let ((map (make-sparse-keymap))
@@ -706,15 +702,13 @@
     (modify-syntax-entry ?\n ">     " st)
     st))
 
-(defvar makefile-imake-mode-syntax-table (copy-syntax-table
-					  makefile-mode-syntax-table))
-(if makefile-imake-mode-syntax-table
-    ()
-  (modify-syntax-entry ?/  ". 14" makefile-imake-mode-syntax-table)
-  (modify-syntax-entry ?*  ". 23" makefile-imake-mode-syntax-table)
-  (modify-syntax-entry ?#  "'" makefile-imake-mode-syntax-table)
-  (modify-syntax-entry ?\n ". b" makefile-imake-mode-syntax-table))
-
+(defvar makefile-imake-mode-syntax-table
+  (let ((st (make-syntax-table makefile-mode-syntax-table)))
+    (modify-syntax-entry ?/  ". 14" st)
+    (modify-syntax-entry ?*  ". 23" st)
+    (modify-syntax-entry ?#  "'"    st)
+    (modify-syntax-entry ?\n ". b"  st)
+    st))
 
 ;;; ------------------------------------------------------------
 ;;; Internal variables.
@@ -774,7 +768,7 @@
 ;;; ------------------------------------------------------------
 
 ;;;###autoload
-(defun makefile-mode ()
+(define-derived-mode makefile-mode nil "Makefile"
   "Major mode for editing standard Makefiles.
 
 If you are editing a file for a different make, try one of the
@@ -858,9 +852,6 @@
    List of special targets. You will be offered to complete
    on one of those in the minibuffer whenever you enter a `.'.
    at the beginning of a line in Makefile mode."
-
-  (interactive)
-  (kill-all-local-variables)
   (add-hook 'write-file-functions
 	    'makefile-warn-suspicious-lines nil t)
   (add-hook 'write-file-functions
@@ -874,59 +865,44 @@
   (make-local-variable 'makefile-need-macro-pickup)
 
   ;; Font lock.
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults
-	;; SYNTAX-BEGIN set to backward-paragraph to avoid slow-down
-	;; near the end of a large buffer, due to parse-partial-sexp's
-	;; trying to parse all the way till the beginning of buffer.
- 	'(makefile-font-lock-keywords
- 	  nil nil
- 	  ((?$ . "."))
- 	  backward-paragraph
-	  (font-lock-syntactic-keywords
-	   . makefile-font-lock-syntactic-keywords)))
+  (set (make-local-variable 'font-lock-defaults)
+       ;; SYNTAX-BEGIN set to backward-paragraph to avoid slow-down
+       ;; near the end of a large buffer, due to parse-partial-sexp's
+       ;; trying to parse all the way till the beginning of buffer.
+       '(makefile-font-lock-keywords
+         nil nil
+         ((?$ . "."))
+         backward-paragraph
+         (font-lock-syntactic-keywords
+          . makefile-font-lock-syntactic-keywords)))
 
   ;; Add-log.
-  (make-local-variable 'add-log-current-defun-function)
-  (setq add-log-current-defun-function 'makefile-add-log-defun)
+  (set (make-local-variable 'add-log-current-defun-function)
+       'makefile-add-log-defun)
 
   ;; Imenu.
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression makefile-imenu-generic-expression)
+  (set (make-local-variable 'imenu-generic-expression)
+       makefile-imenu-generic-expression)
 
   ;; Dabbrev.
-  (make-local-variable 'dabbrev-abbrev-skip-leading-regexp)
-  (setq dabbrev-abbrev-skip-leading-regexp "\\$")
+  (set (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) "\\$")
 
   ;; Other abbrevs.
   (setq local-abbrev-table makefile-mode-abbrev-table)
 
   ;; Filling.
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'makefile-fill-paragraph)
+  (set (make-local-variable 'fill-paragraph-function) 'makefile-fill-paragraph)
 
   ;; Comment stuff.
-  (make-local-variable 'comment-start)
-  (setq comment-start "#")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#+[ \t]*")
+  (set (make-local-variable 'comment-start) "#")
+  (set (make-local-variable 'comment-end) "")
+  (set (make-local-variable 'comment-start-skip) "#+[ \t]*")
 
   ;; Make sure TAB really inserts \t.
   (set (make-local-variable 'indent-line-function) 'indent-to-left-margin)
 
-  ;; become the current major mode
-  (setq major-mode 'makefile-mode)
-  (setq mode-name "Makefile")
-
-  ;; Activate keymap and syntax table.
-  (use-local-map makefile-mode-map)
-  (set-syntax-table makefile-mode-syntax-table)
-
   ;; Real TABs are important in makefiles
-  (setq indent-tabs-mode t)
-  (run-mode-hooks 'makefile-mode-hook))
+  (setq indent-tabs-mode t))
 
 ;; These should do more than just differentiate font-lock.
 ;;;###autoload