;; 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)))