;; eyesore code editing commands for Emacs
;; Copyright (C) 1992 Lars Ingebrigtsen

(load "cddb.el")

(defconst eye-bracket-indent-level 2
  "Indentation of eyesore statements with respect to containing block.")

(defconst eye-mode-map nil "")
(if eye-mode-map
    ()
  (setq eye-mode-map (make-sparse-keymap))

  (define-key eye-mode-map "[" 'eye-bracket-begin)
  (define-key eye-mode-map "]" 'eye-bracket-end)
  (define-key eye-mode-map "\177" 'backward-delete-char-untabify)
  (define-key eye-mode-map "\t" 'eye-indent-line)

  (define-key eye-mode-map "\C-j" 'eye-return-and-indent)
  (define-key eye-mode-map "\C-cr" 'eye-new-release)
  (define-key eye-mode-map "\C-c\C-t" 'eye-new-track)
  (define-key eye-mode-map "\C-ct" 'eye-track-on-old-track)
  (define-key eye-mode-map "\C-cf" 'eye-new-format)
  (define-key eye-mode-map "\C-cc" 'eye-new-comment)
  (define-key eye-mode-map "\C-cq" 'eye-justify-paragraph)
  (define-key eye-mode-map "\C-cg" 'eye-justify-rest-of-buffer)
  (define-key eye-mode-map "\C-cT" 'eye-copy-title)  
  (define-key eye-mode-map "\C-cn" 'eye-get-non-ident)
  (define-key eye-mode-map "\C-c\C-n" 'eye-count-tracks)

  (define-key eye-mode-map "\C-cl" 'eye-load)
  (define-key eye-mode-map "\C-t" 'eye-indent-line)

  (define-key eye-mode-map "\C-xt" 'eye-track-buffer)
  (define-key eye-mode-map "\C-xe" 'eye-track-extend)
  (define-key eye-mode-map "\C-xr" 'eye-track-reverse)
  
  
)
  
(defun eye-mode ()
  "Major mode for editing eyesore files.

C-cr: New release
C-ct: New track
C-cf: New format
C-cc: New comment

C-cq: Justify paragraph
C-cg: Justify rest of buffer

C-cT: Copy title
C-cC-n: Get non-ident
"
  (interactive)
  (kill-all-local-variables)
  (setq mode-name "eyesore")
  (setq major-mode 'eye-mode)
  (use-local-map eye-mode-map)
  (modify-syntax-entry ?\" "w")
  (modify-syntax-entry ?\' "w")
  (auto-fill-mode 0)
  )

(defun eye-bracket-begin ()
  "Inserts a \[ and indents the line."
  (interactive)
  (insert "\[")
  (eye-indent-line)
  )

(defun eye-bracket-end ()
  "Inserts a \], indents the line and blinks the matching bracket."
  (interactive)
  (insert "\]")
  (eye-indent-line)
  (blink-matching-open)
  )

(defun eye-count-tracks ()
  (interactive)
  (let ((track "^        [{~]\\|^\t[{~]")
	(n 0))
    (save-excursion
      (beginning-of-line)
      (while (looking-at "        \\|\t")
	(forward-line -1))
      (forward-line 1)
      (while (looking-at "        \\|\t")
	(if (looking-at track) (setq n (1+ n)))
	(forward-line 1)))
    (message "Tracks: %s" n)))
  
(defun eye-indent-line ()
  "Indents the current line of eyesore code according to surrounding block."
  (interactive)
  (let (eye-beg-file eye-indentation eye-at-beginning-of-line eye-blank-line
		     eye-beg)

    (setq eye-beg-file nil)

    (save-restriction
      (save-excursion
	(setq eye-indentation 0)
      
	(if (/= (forward-line -1) 0)
	    (setq eye-beg-file t)
	  (progn
	    (while (and (not eye-beg-file) (looking-at "[ \t]*$"))
	      (if (/= (forward-line -1) 0)
		  (setq eye-beg-file t)))))
      
	(if (not eye-beg-file)
	    (progn
	      (setq eye-indentation (current-indentation))
	      (re-search-forward "[^ \t]")
	    
	      (if (char-equal (following-char) ?\])
		  (forward-char))
	    
	      (while (not (char-equal (following-char) ?\n))
		(if (char-equal (following-char) ?\[)
		    (setq eye-indentation
			  (+ eye-indentation eye-bracket-indent-level)))
		(if (char-equal (following-char) ?\])
		    (setq eye-indentation
			  (- eye-indentation eye-bracket-indent-level)))
		(forward-char))))))
    
    (if eye-beg-file
	(setq eye-indentation 0))
  
    (save-restriction
      (save-excursion
	(beginning-of-line)
      
	(if (looking-at "[ \t]*[^ \t]")
	    (setq eye-at-beginning-of-line t)
	  (setq eye-at-beginning-of-line nil))
      
	(if (looking-at "[ \t]*\]")
	    (setq eye-indentation
		  (max (- eye-indentation eye-bracket-indent-level) 0)))
      
	(if (looking-at "[ \t]*$")
	    (setq eye-blank-line t)
	  (setq eye-blank-line nil))

	(setq eye-beg (point))
	(re-search-forward "[^ \t]")
	(backward-char)
	(delete-region eye-beg (point))
	(indent-to eye-indentation)))

    (if eye-at-beginning-of-line
	(progn
	  (re-search-forward "[^ \t]")
	  (backward-char)))

    (if eye-blank-line
	(end-of-line))))

(defun eye-copy-title ()
  "Copies the title string to point."
  (interactive)
  (let (beg end)
    (save-restriction
      (save-excursion
      (re-search-backward "release")
      (re-search-forward "{[^}]*}{[^}]*}")
      (setq beg (point))
      (re-search-forward "}")
      (setq end (point))))
    (insert-buffer-substring beg end)))


(defun eye-new-track ()
  "Inserts a new track to point."
  (interactive)
  (insert "~{}\[\]")
  (eye-indent-line)
  (beginning-of-line)
  (search-forward "~{"))

(defun eye-track-on-old-track ()
  "Takes a track with a null track command and puts an explicit track cmd there."
  (interactive)
  (let (end)
    (save-restriction
      (end-of-line)
      (setq end (point))
      (beginning-of-line)
      (if (search-forward "{" end t)
	  (progn
	    (backward-char)
	    (insert "~")
	    (search-forward "}")
	    (insert "\[\]")
	    (eye-indent-line)
	    (beginning-of-line)
	    (search-forward "\["))))))

(defun eye-new-format ()
  "Inserts a new comment to point."
  (interactive)
  (insert "format\[\]\[\]")
  (eye-indent-line)
  (beginning-of-line)
  (search-forward "format\["))

(defun eye-new-comment ()
  "Inserts a new comment to point."
  (interactive)
  (insert "comment\[\]")
  (eye-indent-line)
  (beginning-of-line)
  (search-forward "comment\["))
  
(defun eye-load ()
  "Load this file. For test purposes."
  (interactive)
  (load "~/Catalogue/lisp/eye-mode"))

(defun eye-justify-paragraph ()
  "Justify a paragraph."
  (interactive)
  (let (end-par beg-par)
    (save-restriction
      (save-excursion

	(setq paragraph-start "^[ \t]*$")
	(forward-paragraph)
	(beginning-of-line)
	(setq end-par (count-lines 1 (point)))
	(backward-paragraph)
	(setq beg-par (count-lines 1 (point)))

	(while (>= end-par beg-par)
	  (eye-indent-line)
	  (setq beg-par (1+ beg-par))
	  (forward-line 1))))))

(defun eye-justify-rest-of-buffer ()
  "Justify the rest of the buffer."
  (interactive)
  (save-restriction
    (save-excursion
      (backward-paragraph)
      (while (not (eobp))
	(eye-indent-line)
	(forward-line 1)))))

(defun eye-new-release () 
  "Create a new release."
  (interactive)
  (insert "release{}{}{}[")
  (eye-indent-line)
  (insert "\nformats[][")
  (eye-indent-line)
  (insert "\n]")
  (eye-indent-line)
  (insert "\ncomments[")
  (eye-indent-line)
  (insert "\n]")
  (eye-indent-line)
  (insert "\n]")
  (eye-indent-line)
  (insert "\n")
  (forward-word -3)
  (skip-chars-forward "release{"))

(defun eye-return-and-indent ()
  "Inserts a newline and indents the line."
  (interactive)
  (newline)
  (eye-indent-line))

(defun eye-get-non-ident ()
  "Searches for a unique non-ident."
  (interactive)
  (let (beg here bline ident idents ids id numident identn found)
    (save-restriction
      (setq here (point))
      (beginning-of-line)
      (setq bline (point))
      (end-of-line)
      (narrow-to-region bline (point))
      (goto-char here)
      (if (looking-at "\}") (goto-char (1- (point))))
      (while (and (looking-at "[^\{\}]") 
		  (= (1- (point)) (goto-char (1- (point))))))
      (if (not (looking-at "\{"))
	  (message "Not in a string1")
	(setq beg (1+ (point)))
	(forward-char)
	(while (and (looking-at "[^\{\}]") 
		  (= (1+ (point)) (goto-char (1+ (point))))))
	(if (not (looking-at "\}"))
	    (message "Not in a string2")
	  (widen)
	  (setq ident (buffer-substring beg (point)))
	  (save-excursion
	    (goto-char 1)
	    (while (re-search-forward (concat "{" ident) nil t)
	      (setq beg (1+ (match-beginning 0)))
	      (goto-char (match-end 0))
	      (while (and (looking-at "[0-9]") 
			  (= (1+ (point)) (goto-char (1+ (point))))))
	      (if (looking-at "\}")
		  (progn
		    (setq idents 
			  (cons (buffer-substring beg (point)) idents))))))
	    
	  (setq idents (sort idents 'string<))
	  (setq numident 0)
	  (setq found t)
	  (while found
	    (setq numident (1+ numident))
	    (setq identn (concat ident (int-to-string numident)))
	    (setq ids idents)
	    (setq found nil)
	    (while ids
	      (setq id (car ids))
	      (setq ids (cdr ids))
	      (if (string= id identn)
		  (setq found t))))
	  (insert (int-to-string numident))
	  ))
      )))

(defun eye-track-buffer ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (replace-regexp "^ *\\(.+\\) *$" "{\\1}")))

(defun eye-track-extend (arg)
  (interactive "sString: ")
  (save-excursion
    (goto-char (point-min))
    (replace-regexp 
     "{\\(.+\\)}"
     (format "~{\\1}[%s]" arg))))

(defun eye-track-reverse ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (replace-regexp "^\\W*\\(.+\\)\\W*-\\W*\\(.*\\)\\W*$" "~{\\2}[group{\\1}]")))

(defun eye-insert-id (file)
  (interactive "fId file: ")
  (let ((alist (cddb-parse file)))
    (insert (format "cddb{%s %s %s}\n"
		    (cdr (assq 'id alist))
		    (mapconcat 'identity (cdr (assq 'frames alist)) " ")
		    (cdr (assq 'length alist))))
    (dolist (track (cdr (assq 'tracks alist)))
      (if (string-match " (\\(.*\\))" track)
	  (insert (format "~{%s}[version{%s}]\n"
			  (substring track 0 (match-beginning 0))
			  (substring track (match-beginning 1)
				     (match-end 1))))
	(insert (format "{%s}\n" track))))))

(defun eye-insert-stats (file)
  (interactive "fStats file: ")
  (let ((track-spec "")
	group title tracks track clock)
    (with-temp-buffer
      (insert-file-contents file)
      (when (re-search-forward "Artist: \\(.*\\)" nil t)
	(setq group (match-string 1)))
      (when (re-search-forward "Title: \\(.*\\)" nil t)
	(setq title (match-string 1)))
      (search-forward "\n\n")
      (while (not (eobp))
	(when (looking-at "\\([0-9]+\\) [0-9]+ \\(.*\\)")
	  (setq track (match-string 2)
		clock (jukebox-raw-to-clock
		       (* (/ (* 1.0 (string-to-number (match-string 1)) 1024)
			     2048)
			  2352)))
	  (push (list (substring track 3) clock) tracks))
	(forward-line 1)))
    ;; Copy sleeve over.
    (let ((sleeve (concat (file-name-directory file) "sleeve.jpg"))
	  (new-name (format "~/Catalogue/data/4ad-pics/%s.%s.cd.jpg"
			    (eye-unspace group)
			    (eye-unspace title))))
      (when (file-exists-p sleeve)
	(copy-file sleeve new-name))
      (set-mark (point))
      (insert
       (format
	"    release{}{%s}{%s}[\n      formats[{cd}][\n%s%s      ]\n      comments[\n      ]\n    ]\n\n"
	group title
	(if (file-exists-p sleeve)
	    (format "        external{%s}\n"
		    (file-name-nondirectory new-name))
	  "")
	(progn
	  (dolist (elem (reverse tracks))
	    (let ((track (pop elem))
		  (clock (pop elem))
		  version)
	      (when (string-match " (\\(.*\\))" track)
		(setq version (substring track (match-beginning 1)
					 (match-end 1))
		      track (substring track 0 (match-beginning 0))))
	      (setq track-spec
		    (concat track-spec
			    (format "        ~{%s}[%stime{%s}]\n"
				    track
				    (if version
					(format "version{%s}" version)
				      "")
				    clock)))))
	  track-spec))))))

(defun eye-unspace (string)
  (with-temp-buffer
    (insert string)
    (goto-char (point-min))
    (while (re-search-forward " " nil t)
      (delete-backward-char)
      (insert (format "%c" (upcase (following-char))))
      (delete-char))
    (goto-char (point-min))
    (while (re-search-forward "[^A-Za-z0-9]" nil t)
      (delete-backward-char))
    (buffer-string)))
