Manipulate Spotlight comments in Dired.

spotlight-comment.el

;;; spotlight-comment.el --- Manipulate Spotlight comments in Dired

;; Copyright (C) 2011  Kouzuka

;; Version: 0.1
;; Author: Kouzuka
;; Keywords: dired, files
;; Compatibility: GNU Emacs 22 and 23, Mac OS X 10.4 or above
;; Created: 2011-03-26
;; Last-Updated: 2011-03-27
;; URL: https://gist.github.com/888153
;; URL: http://kouzuka.blogspot.com/2011/03/dired-spotlight.html

;; This file is NOT part of GNU Emacs.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This package provides commands to manipulate Spotlight comments
;; (Finder comments) in Dired on Mac OS X 10.4 or above.
;;
;; The commands are:
;; `spotlight-comment-dired-show'       Show Spotlight comment
;; `spotlight-comment-dired-edit'       Edit Spotlight comment
;; `spotlight-comment-dired-delete'     Delete Spotlight comment
;; `spotlight-comment-dired-set'        Set Spotlight comment
;; `spotlight-comment-dired-add-tag'    Add tags to Spotlight comment
;; `spotlight-comment-dired-delete-tag' Delete tags from Spotlight comment
;; `spotlight-comment-dired-mark'       Mark files that have some tags in
;;                                      Spotlight comment
;;
;; All of comment manipulations are done by Finder via AppleScript.
;; This package uses `osascript' instead of `do-applescript' so that
;; it runs on X11 Emacs and Cocoa Emacs with "-nw" mode, as well.
;;
;; Installation:
;;
;; Put this file into `load-path' and add this code to your ~/.emacs.el
;; or ~/.emacs.d/init.el.
;;
;; (require 'spotlight-comment)
;; (define-key dired-mode-map "\M-c" spotlight-comment-dired-prefix-map)
;;
;; See below for the key bindings.

;;; Code:

(require 'dired)

(defgroup spotlight-comment nil
  "Manipulate Spotlight comments in Dired."
  :group 'dired)

(defcustom spotlight-comment-separator ", "
  "A string used as tag separators in Spotlight comments."
  :type 'string
  :group 'spotlight-comment)

;; When reading tags in the minibuffer, this package tries to complete
;; tags from the minibuffer history in most cases.
;; This variable is provided for those who don't use savehist.el or
;; session.el.
(defcustom spotlight-comment-user-tags nil
  "A list of strings for minibuffer tag completion."
  :type '(repeat :tag "List of tags" (string :tag "Tag"))
  :group 'spotlight-comment)

(defcustom spotlight-comment-dired-delete-confirm t
  "Non-nil means ask a user (y or n) when deleting Spotlight comments."
  :type 'boolean
  :group 'spotlight-comment)

(defvar spotlight-comment-dired-prefix-map
  (let ((map (make-sparse-keymap)))
    (define-key map "y" 'spotlight-comment-dired-show)
    (define-key map "e" 'spotlight-comment-dired-edit)
    (define-key map "D" 'spotlight-comment-dired-delete)
    (define-key map "s" 'spotlight-comment-dired-set)
    (define-key map "a" 'spotlight-comment-dired-add-tag)
    (define-key map "d" 'spotlight-comment-dired-delete-tag)
    (define-key map "m" 'spotlight-comment-dired-mark)
    map)
  "Keymap for spotlight-comment-dired-*.")

(defvar spotlight-comment-dired-comment-history nil)
(defvar spotlight-comment-dired-tag-history nil)

(defun spotlight-comment-get (file)
  "Return the Spotlight comment of FILE."
  (require 'ucs-normalize nil t)
  (let* ((coding-system (cond
                         ((coding-system-p 'utf-8-hfs)
                          'utf-8-hfs)
                         ((coding-system-p 'utf-8m)
                          'utf-8m)
                         (t
                          'utf-8)))
         (process-coding-system-alist `(("osascript" ,coding-system . utf-8)))
         (script
          (concat
           "on run argv\n"
           "    set i to (item 1 of argv as POSIX file as Unicode text)\n"
           "    tell application \"Finder\"\n"
           "        get comment of item i\n"
           "    end tell\n"
           "end run\n"))
         status)
    (with-temp-buffer
      (setq status (call-process "osascript" nil t nil
                                 "-e" script (expand-file-name file)))
      (if (eq status 0)
          (progn
            (when (and (not (bobp)) (bolp))
              (delete-char -1))
            (buffer-string))
        ""))))

(defun spotlight-comment-set (file comment)
  "Set the Spotlight comment of FILE to COMMENT.
Return an exit status if succeeded."
  (let ((process-coding-system-alist '(("osascript" utf-8 . utf-8)))
        (script
         (concat
          "on run argv\n"
          "    set i to (item 1 of argv as POSIX file as Unicode text)\n"
          "    set c to (item 2 of argv as Unicode text)\n"
          "    tell application \"Finder\"\n"
          "        set comment of item i to c\n"
          "    end tell\n"
          "end run\n")))
    (call-process "osascript" nil nil nil
                  "-e" script (expand-file-name file) comment)))

(defun spotlight-comment-get-tag (file)
  (let ((tags (split-string (spotlight-comment-get file)
                            (regexp-quote spotlight-comment-separator))))
    (delete "" tags)))

(defun spotlight-comment-add-tag (file &rest tags)
  "Add TAGS to the Spotlight comment of FILE."
  (let* ((current-tags (spotlight-comment-get-tag file))
         (new-tags (copy-sequence current-tags)))
    (setq tags (delete "" tags)
          tags (delete spotlight-comment-separator tags)
          tags (delete nil tags))
    (mapc (lambda (x)
            (add-to-list 'new-tags x t))
          tags)
    (unless (equal current-tags new-tags)
      (setq new-tags (mapconcat 'identity
                                new-tags
                                spotlight-comment-separator))
      (spotlight-comment-set file new-tags))))

(defun spotlight-comment-delete-tag (file &rest tags)
  "Delete TAGS from the Spotlight comment of FILE."
  (let* ((current-tags (spotlight-comment-get-tag file))
         (new-tags (copy-sequence current-tags)))
    (setq tags (delete "" tags)
          tags (delete spotlight-comment-separator tags)
          tags (delete nil tags))
    (mapc (lambda (x)
            (setq new-tags (delete x new-tags)))
          tags)
    (unless (equal current-tags new-tags)
      (setq new-tags (mapconcat 'identity
                                new-tags
                                spotlight-comment-separator))
      (spotlight-comment-set file new-tags))))

;; unused
(defun spotlight-comment-has-one-tag-p (file &rest tags)
  "Return non-nil if FILE has one of TAGS."
  (let ((current-tags (spotlight-comment-get-tag file)))
    (delq nil (mapcar (lambda (x)
                        (member x current-tags))
                      tags))))

;; unused
(defun spotlight-comment-has-all-tag-p (file &rest tags)
  "Return non-nil if FILE has all of TAGS."
  (let ((current-tags (spotlight-comment-get-tag file)))
    (null (memq nil (mapcar (lambda (x)
                              (member x current-tags))
                            tags)))))

;; spotlight-comment-dired-*

;;;###autoload
(defun spotlight-comment-dired-show (file &optional arg)
  "Show the Spotlight comment of FILE.
With prefix ARG, save the comment to kill-ring."
  (interactive (list (dired-get-filename) current-prefix-arg))
  (let ((comment (spotlight-comment-get file)))
    (if (string-equal comment "")
        (message "No Spotlight comment")
      (when arg
        (kill-new comment))
      (message "%s" comment))))

;;;###autoload
(defun spotlight-comment-dired-edit (file)
  "Edit the Spotlight comment of FILE."
  (interactive (list (dired-get-filename)))
  (let ((old-comment (spotlight-comment-get file))
        new-comment
        status)
    (setq new-comment (read-string "Edit Spotlight comment: "
                                   old-comment
                                   'spotlight-comment-dired-comment-history))
    (if (string-equal old-comment new-comment)
        (message "Canceled")
      (setq status (spotlight-comment-set file new-comment))
      (if (eq status 0)
          (message "Wrote comment")
        (message "Failed to write comment")))))

;;;###autoload
(defun spotlight-comment-dired-delete (&rest files)
  "Delete the Spotlight comment of the marked FILES.

If no files are marked or a specific numeric prefix arg is given,
the next arg files are used.  Just \\[universal-argument] means the current file.

To suppress `y-or-n-p' confirmation, set `spotlight-comment-dired-delete-confirm'
to nil."
  (interactive
   (apply 'list (dired-get-marked-files nil current-prefix-arg)))
  (let ((count 0)
        status)
    (when (and spotlight-comment-dired-delete-confirm
               (not (y-or-n-p "Delete Spotlight comments? ")))
      (error "Canceled"))
    (message "Deleting comments...")
    (dolist (file files)
      (unless (string-equal (spotlight-comment-get file) "")
        (setq status (spotlight-comment-set file ""))
        (when (eq status 0)
          (setq count (1+ count)))))
    (message "Deleting comments...done")
    (message "Comments deleted from %d file%s" count (if (= count 1) "" "s"))))

;;;###autoload
(defun spotlight-comment-dired-set (comment &rest files)
  "Set the Spotlight comment of the marked FILES to COMMENT.

If no files are marked or a specific numeric prefix arg is given,
the next arg files are used.  Just \\[universal-argument] means the current file."
  (interactive
   (apply 'list
          (read-string "Set Spotlight comment: "
                       nil 'spotlight-comment-dired-comment-history)
          (dired-get-marked-files nil current-prefix-arg)))
  (let ((count 0)
        status)
    (when (and spotlight-comment-dired-delete-confirm
               (string-equal comment "")
               (not (y-or-n-p "Comment empty.  Delete Spotlight comments? ")))
      (error "Canceled"))
    (message "Setting comments...")
    (dolist (file files)
      (setq status (spotlight-comment-set file comment))
      (when (eq status 0)
        (setq count (1+ count))))
    (message "Setting comments...done")
    (message "Comments set to %d file%s" count (if (= count 1) "" "s"))))


;; Tag manipulation

(defun spotlight-comment-dired-read-tag (prompt &optional file)
  ;; Read the minibuffer and return a list of tags.
  (let ((collection (append spotlight-comment-user-tags
                            spotlight-comment-dired-tag-history))
        tag tags)
    (when file
      (setq collection (append collection (spotlight-comment-get-tag file))))
    (while (not (string-equal tag ""))
      (setq tag (completing-read prompt collection nil nil nil
                                 'spotlight-comment-dired-tag-history))
      (unless (string-equal tag "")
        (setq collection (delete tag collection))
        (add-to-list 'tags tag t)))
    tags))

;;;###autoload
(defun spotlight-comment-dired-add-tag (tag &rest files)
  "Add TAG to the Spotlight comment of the marked FILES.

If no files are marked or a specific numeric prefix arg is given,
the next arg files are used.  Just \\[universal-argument] means the current file.

To enter SPC or TAB in the minibuffer, use \\[quoted-insert].

In non-interactive calls, TAG is a string separated by
`spotlight-comment-separator'."
  (interactive
   (let ((files (dired-get-marked-files nil current-prefix-arg))
         (tag (mapconcat 'identity
                         (spotlight-comment-dired-read-tag
                          "Add tags (empty string to finish): ")
                         spotlight-comment-separator)))
     (apply 'list tag files)))
  (message "Adding tags...")
  (dolist (file files)
    (apply 'spotlight-comment-add-tag
           file
           (split-string tag (regexp-quote spotlight-comment-separator))))
  (message "Adding tags...done"))

;;;###autoload
(defun spotlight-comment-dired-delete-tag (tag &rest files)
  "Delete TAG from the Spotlight comment of the marked FILES.

If no files are marked or a specific numeric prefix arg is given,
the next arg files are used.  Just \\[universal-argument] means the current file.

To enter SPC or TAB in the minibuffer, use \\[quoted-insert].

In non-interactive calls, TAG is a string separated by
`spotlight-comment-separator'."
  (interactive
   (let* ((files (dired-get-marked-files nil current-prefix-arg))
          (tag (mapconcat 'identity
                          (spotlight-comment-dired-read-tag
                           "Delete tags (empty string to finish): "
                           (car files))
                          spotlight-comment-separator)))
     (apply 'list tag files)))
  (message "Deleting tags...")
  (dolist (file files)
    (apply 'spotlight-comment-delete-tag
           file
           (split-string tag (regexp-quote spotlight-comment-separator))))
  (message "Deleting tags...done"))

(defun spotlight-comment-dired-mark-file (file)
  ;; Mark FILE. Return non-nil if marking was performed.
  (let (buffer-read-only)
    (save-excursion
      (when (and (dired-goto-file file)
                 (forward-line 0)
                 (null (looking-at (regexp-quote
                                    (char-to-string dired-marker-char)))))
        (delete-char 1)
        (insert dired-marker-char)
        t))))

(defun spotlight-comment-dired-file-list (dir &rest tags)
  ;; Return a list of files in DIR.
  ;; The files contain all of TAGS in the Spotlight comment.
  (require 'ucs-normalize nil t)
  (let* ((coding-system (cond
                         ((coding-system-p 'utf-8-hfs)
                          'utf-8-hfs)
                         ((coding-system-p 'utf-8m)
                          'utf-8m)
                         (t
                          'utf-8)))
         (process-coding-system-alist `(("mdfind" ,coding-system . utf-8)))
         (query (mapconcat
                 (lambda (x)
                   (format "(kMDItemFinderComment == \"%s\"cdw)" x))
                 tags
                 " && "))
         status output)
    (setq output (with-temp-buffer
                   (setq status (call-process "mdfind" nil t nil
                                              "-onlyin" dir query))
                   (if (eq status 0)
                       (progn
                         (when (and (not (bobp)) (bolp))
                           (delete-char -1))
                         (buffer-string))
                     nil)))
    (when (> (length output) 0)
      (split-string output "\n"))))

;;;###autoload
(defun spotlight-comment-dired-mark (&optional arg &rest tags)
  "Mark files that have all of TAGS in the Spotlight comment.
With prefix ARG, unmark them.

To enter SPC or TAB in the minibuffer, use \\[quoted-insert]."
  (interactive
   (apply 'list
          current-prefix-arg
          (spotlight-comment-dired-read-tag
           (format
            "%sark with tags (empty string to finish): "
            (if current-prefix-arg "Unm" "M")))))
  (let ((dired-marker-char (if arg ?\040 dired-marker-char)) ; \040 = SPC
        (dir (or (car (rassoc (current-buffer) dired-buffers))
                 default-directory))
        (count 0)
        files)
    (when (and tags (car tags))
      (message "%sarking files with tags..." (if arg "Unm" "M"))
      (setq files (apply 'spotlight-comment-dired-file-list dir tags))
      (when (> (length files) 0)
        (mapc (lambda (x)
                (when (spotlight-comment-dired-mark-file x)
                  (setq count (1+ count))))
              files))
      (message "%sarking files with tags...done" (if arg "Unm" "M"))
      (message "%sarked %d file%s"
               (if arg "Unm" "M")
               count
               (if (= count 1) "" "s")))))

(provide 'spotlight-comment)
;;; spotlight-comment.el ends here