]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/transcribe/transcribe.el
packages/transcribe.el: Fixed void function declaration
[gnu-emacs-elpa] / packages / transcribe / transcribe.el
index 31bc6307da1eff5dd5e57206e2c90de43c0ee606..a2819faaa16b1de42874e88701bf6da5a8469dfe 100644 (file)
@@ -1,9 +1,9 @@
 ;;; transcribe.el --- Package for audio transcriptions
 
 ;;; transcribe.el --- Package for audio transcriptions
 
-;; Copyright 2014-2015  Free Software Foundation, Inc.
+;; Copyright 2014-2016  Free Software Foundation, Inc.
 
 ;; Author: David Gonzalez Gandara <dggandara@member.fsf.org>
 
 ;; Author: David Gonzalez Gandara <dggandara@member.fsf.org>
-;; Version: 1.3.0
+;; Version: 1.5.0
 
 ;; 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
 
 ;; 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
@@ -23,7 +23,7 @@
 ;; REQUIRES:
 ;; -----------------------------
 ;; This module works without any requires, but in order to use the audio 
 ;; REQUIRES:
 ;; -----------------------------
 ;; This module works without any requires, but in order to use the audio 
-;; functions, you need to install the emacs package "emms", by Joe Drew, 
+;; functions, you need to install the Emacs package "emms", by Joe Drew, 
 ;; and the external program "mpg321", by Jorgen Schafer and Ulrik Jensen,
 ;; both under GPL licenses.
 ;;
 ;; and the external program "mpg321", by Jorgen Schafer and Ulrik Jensen,
 ;; both under GPL licenses.
 ;;
 
 ;;; Code:
 
 
 ;;; Code:
 
-(if t (require 'emms-setup))
-;(require 'emms-player-mpd)
-;(setq emms-player-mpd-server-name "localhost")
-;(setq emms-player-mpd-server-port "6600")
+(require 'xml)
+
+;; (if t (require 'emms-setup))
+;; (require 'emms-player-mpd)
+;; (setq emms-player-mpd-server-name "localhost")
+;; (setq emms-player-mpd-server-port "6600")
 
 (emms-standard)
 (emms-default-players)
 
 (emms-standard)
 (emms-default-players)
@@ -95,7 +97,7 @@
 (defvar transcribe-function-list '("initiating" "responding" "control" "expresive" "interpersonal"))
 (defvar transcribe-move-list '("initiation" "response" "follow-up"))
 (defvar transcribe-attribute-list '("clauses" "errors" "function" "move"))
 (defvar transcribe-function-list '("initiating" "responding" "control" "expresive" "interpersonal"))
 (defvar transcribe-move-list '("initiation" "response" "follow-up"))
 (defvar transcribe-attribute-list '("clauses" "errors" "function" "move"))
-;(append transcribe-attribute-list transcribe-function-list transcribe-move-list)
+;(append transcribe-attribute-list transcribe-function-list transcribe-move-list)
 
 (defun transcribe-analyze-episode (episode person)
   "This calls the external python package analyze_episodes2.py. The new 
 
 (defun transcribe-analyze-episode (episode person)
   "This calls the external python package analyze_episodes2.py. The new 
    and the persons and the utterances only. The raw transcription will be send to buffer called
    'Raw Output'"
   (interactive)
    and the persons and the utterances only. The raw transcription will be send to buffer called
    'Raw Output'"
   (interactive)
-  (let* ((interventionsl2 '())
-     (interventionsl1 '())
-     (xml (xml-parse-region (point-min) (point-max)))
-     (results (car xml))
-     (episodes (xml-get-children results 'episode))
-     (clausesmessage nil)
-     (number nil))
+  (let* ((xml (xml-parse-region (point-min) (point-max)))
+    (results (car xml))
+    (episodes (xml-get-children results 'episode)))
    
    
-     (dolist (episode episodes)
-           (let* ((transcription (xml-get-children episode 'transcription))
-             (participantsnode (xml-get-children episode 'participants))
-             (participantsstring (nth 2 (car participantsnode)))
-             (participants (split-string participantsstring)))
+    (dolist (episode episodes)
+      (let* ((transcription (xml-get-children episode 'transcription)))
    
    
-             (dolist (turn transcription)
-                 (dolist (intervention (xml-node-children turn))
-                   (when (listp intervention)
-                      (save-excursion
-                       (set-buffer "Raw Output")
-                       (insert (format "%s: " (car intervention)))
-                       (dolist (utterance (nthcdr 2 intervention))
-                         (when (listp utterance)
-                           (insert (format "%s "  (nth 2 utterance)))))
-                       (insert "\n")))))))))
+        (dolist (turn transcription)
+          (dolist (intervention (xml-node-children turn))
+            (if (listp intervention)
+              (progn 
+                (with-current-buffer "Raw Output"
+                  (insert (format "%s\t" (line-number-at-pos)))
+                  (insert (format "%s:\t" (car intervention)))
+                  (dolist (utterance (nthcdr 2 intervention))
+                    (if (listp utterance)
+                       (progn
+                         (insert (format "%s "  (nth 2 utterance))))
+
+                         (insert (format "%s" utterance))))))
+                        
+                       (with-current-buffer "Raw Output"
+                         (insert (format "%s" (line-number-at-pos)))
+                         (insert (format "%s" intervention))))))))))
 
 (defun transcribe-analyze (episodenumber personid)
   "Extract from a given episode and person the number of asunits per 
 
 (defun transcribe-analyze (episodenumber personid)
   "Extract from a given episode and person the number of asunits per 
      (episodes (xml-get-children results 'episode))
      (asunitsl2 0.0000)
      (asunitsl1 0.0000)
      (episodes (xml-get-children results 'episode))
      (asunitsl2 0.0000)
      (asunitsl1 0.0000)
-     (shifts 0.0000);; TODO implement
+     ;; (shifts 0.0000);; TODO implement
      (initiating 0.0000);; TODO implement
      (responding 0.0000);; TODO implement
      (control 0.0000);; TODO implement
      (expressive 0.0000);; TODO implement
      (interpersonal 0.0000);; TODO implement
      (clausesl1 0.0000)
      (initiating 0.0000);; TODO implement
      (responding 0.0000);; TODO implement
      (control 0.0000);; TODO implement
      (expressive 0.0000);; TODO implement
      (interpersonal 0.0000);; TODO implement
      (clausesl1 0.0000)
-     (errorsl1 0.0000);; TODO implement
+     ;; (errorsl1 0.0000);; TODO implement
      (clausesl2 0.0000)
      (errorsl2 0.0000)
      (duration nil)
      (role nil)
      (context nil)
      (demand nil)
      (clausesl2 0.0000)
      (errorsl2 0.0000)
      (duration nil)
      (role nil)
      (context nil)
      (demand nil)
-     (clausesmessage nil)
+     ;; (clausesmessage nil)
      (number nil))
          
      (dolist (episode episodes)
      (number nil))
          
      (dolist (episode episodes)
                 (setq role (nth 2 (car rolenode)))
                 (setq context (nth 2 (car contextnode)))
                 (setq demand (nth 2 (car demandnode)))
                 (setq role (nth 2 (car rolenode)))
                 (setq context (nth 2 (car contextnode)))
                 (setq demand (nth 2 (car demandnode)))
-                ;; (save-excursion
-                   ;; (set-buffer "Statistics Output")
+                ;; (with-current-buffer "Statistics Output"
                    ;; (insert (format "role: %s; context: %s; demand: %s\n" role context demand)))
                 ))
 
                    ;; (insert (format "role: %s; context: %s; demand: %s\n" role context demand)))
                 ))
 
                             (setq expressive (+ expressive 1)))
                           (when (string-equal function "interpersonal")
                             (setq interpersonal (+ interpersonal 1)))
                             (setq expressive (+ expressive 1)))
                           (when (string-equal function "interpersonal")
                             (setq interpersonal (+ interpersonal 1)))
-                          (when (not (equal attrs nil))
+                          (when attrs
                             (setq clausesl2 (+ clausesl2 (string-to-number 
                              clausesl2nodeinc)))
                             (setq errorsl2 (+ errorsl2 (string-to-number
                              errorsl2inc))))
                             (setq clausesl2 (+ clausesl2 (string-to-number 
                              clausesl2nodeinc)))
                             (setq errorsl2 (+ errorsl2 (string-to-number
                              errorsl2inc))))
-                          (when (not (equal l2 nil)) 
-                            (add-to-list 'interventionsl2 l2) 
+                          (when l2 
+                            ;; (add-to-list 'interventionsl2 l2)
+                            (cl-pushnew l2 interventionsl2 :test #'equal) 
                             (setq asunitsl2 (1+ asunitsl2)))))
                      (dolist (l1turn l1node)
                        (let*((l1 (nth 2 l1turn))
                             (setq asunitsl2 (1+ asunitsl2)))))
                      (dolist (l1turn l1node)
                        (let*((l1 (nth 2 l1turn))
                          (when (not (equal clausesl1node nil))
                            (setq clausesl1 (+ clausesl1 (string-to-number 
                               clausesl1nodeinc))))
                          (when (not (equal clausesl1node nil))
                            (setq clausesl1 (+ clausesl1 (string-to-number 
                               clausesl1nodeinc))))
-                         (when (not (equal l1 nil)) 
-                           (add-to-list 'interventionsl1 l1) 
+                         (when l1 
+                           ;; (add-to-list 'interventionsl1 l1)
+                           (cl-pushnew l1 interventionsl1 :test #'equal) 
                            (setq asunitsl1 (1+ asunitsl1)))))))))))))
   (reverse interventionsl2)
   ;; (write-region (format "%s" interventionsl2) nil (format "transcribe-output-%s-%s-l2.txt" episodenumber personid))
                            (setq asunitsl1 (1+ asunitsl1)))))))))))))
   (reverse interventionsl2)
   ;; (write-region (format "%s" interventionsl2) nil (format "transcribe-output-%s-%s-l2.txt" episodenumber personid))
     (clausesperasunitl2 (/ clausesl2 asunitsl2))
     (errorsperasunitl2 (/ errorsl2 asunitsl2))
     (asunitspersecondl1 (/ asunitsl1 (string-to-number duration)))
     (clausesperasunitl2 (/ clausesl2 asunitsl2))
     (errorsperasunitl2 (/ errorsl2 asunitsl2))
     (asunitspersecondl1 (/ asunitsl1 (string-to-number duration)))
-    (clausesperasunitl1 (/ clausesl1 asunitsl1))
+    ;; (clausesperasunitl1 (/ clausesl1 asunitsl1))
     (initiatingperasunitl2 (/ initiating asunitsl2))
     (respondingperasunitl2 (/ responding asunitsl2))
     (controlperasunitl2 (/ control asunitsl2))
     (initiatingperasunitl2 (/ initiating asunitsl2))
     (respondingperasunitl2 (/ responding asunitsl2))
     (controlperasunitl2 (/ control asunitsl2))
   
     ;; (princ clausesmessage)
     (princ (format "episode: %s, duration: %s, person: %s\n" episodenumber duration personid))
   
     ;; (princ clausesmessage)
     (princ (format "episode: %s, duration: %s, person: %s\n" episodenumber duration personid))
-    (save-excursion
-      (set-buffer "Statistics Output") 
-      (insert (format "%s,%s,%s,0,0,%s,%s,%s,%s,%s,QUAN-L2,segmented,aux,level,subject,yearofclil,month\n" personid episodenumber duration role context demand asunitspersecondl2 asunitspersecondl1))
-    )
+    (with-current-buffer "Statistics Output" 
+      (insert (format "%s,%s,%s,0,0,%s,%s,%s,%s,%s,QUAN-L2,segmented,aux,level,subject,yearofclil,month\n" personid episodenumber duration role context demand asunitspersecondl2 asunitspersecondl1)))
     (princ (format "L2(Asunits/second): %s, L2(clauses/Asunit): %s, L2(errors/Asunit):%s, L1(Asunits/second): %s\n" 
           asunitspersecondl2 clausesperasunitl2 errorsperasunitl2 asunitspersecondl1))
     (princ (format "Functions/unit: Initiating: %s, Responding: %s, Control: %s, Expressive: %s, Interpersonal: %s" initiatingperasunitl2 respondingperasunitl2 controlperasunitl2 expressiveperasunitl2 interpersonalperasunitl2)))))
     (princ (format "L2(Asunits/second): %s, L2(clauses/Asunit): %s, L2(errors/Asunit):%s, L1(Asunits/second): %s\n" 
           asunitspersecondl2 clausesperasunitl2 errorsperasunitl2 asunitspersecondl1))
     (princ (format "Functions/unit: Initiating: %s, Responding: %s, Control: %s, Expressive: %s, Interpersonal: %s" initiatingperasunitl2 respondingperasunitl2 controlperasunitl2 expressiveperasunitl2 interpersonalperasunitl2)))))
    lost all previous data. The data in the buffer can be saved to a file and be
    passed to 'R' for statistical analysis."
   (interactive)
    lost all previous data. The data in the buffer can be saved to a file and be
    passed to 'R' for statistical analysis."
   (interactive)
-  (let* (
-     (xml (xml-parse-region (point-min) (point-max)))
+  (let* ((xml (xml-parse-region (point-min) (point-max)))
      (results (car xml))
      (episodes (xml-get-children results 'episode)))
   
      (results (car xml))
      (episodes (xml-get-children results 'episode)))
   
-     (save-excursion
-       (set-buffer "Statistics Output")
+     (with-current-buffer "Statistics Output"
        (erase-buffer)
        (insert "person,episode,duration,C-UNITS(L2),C-UNITS(L1),role,context,demand,QUAN-L2,QUAN-L1,QUAL-L2,segmented,aux,level,subjects,yearofCLIL,month\n"))
      (dolist (episode episodes)
        (let* ((numbernode (xml-get-children episode 'number))
          (participantsnode (xml-get-children episode 'participants))
        (erase-buffer)
        (insert "person,episode,duration,C-UNITS(L2),C-UNITS(L1),role,context,demand,QUAN-L2,QUAN-L1,QUAL-L2,segmented,aux,level,subjects,yearofCLIL,month\n"))
      (dolist (episode episodes)
        (let* ((numbernode (xml-get-children episode 'number))
          (participantsnode (xml-get-children episode 'participants))
-         (transcription (xml-get-children episode 'transcription))
+         ;; (transcription (xml-get-children episode 'transcription))
          (number (nth 2 (car numbernode)))
          (participantsstring (nth 2 (car participantsnode)))
          (participants (split-string participantsstring)))
          (number (nth 2 (car numbernode)))
          (participantsstring (nth 2 (car participantsnode)))
          (participants (split-string participantsstring)))
 
 
 (fset 'NewEpisode
 
 
 (fset 'NewEpisode
-      "<episode>\n<number>DATE-NUMBER</number>\n<duration></duration>\n<comment></comment>\n<subject>Subject (level)</subject>\n<participants><\participants>\n<task>\n\t<role>low or high</role>\n<context>low or high</context>\n<demand>low or high</demand>\r</task>\n<auxiliar>Yes/no</auxiliar>\n<transcription>\n</transcription>\n</episode>");Inserts a new episode structure
+      "<episode>\n<number>DATE-NUMBER</number>\n<duration></duration>\n<comment></comment>\n<subject>Subject (level)</subject>\n<participants></participants>\n<task>\n\t<role>low or high</role>\n<context>low or high</context>\n<demand>low or high</demand>\r</task>\n<auxiliar>Yes/no</auxiliar>\n<transcription>\n</transcription>\n</episode>");Inserts a new episode structure
 
 
 (defvar transcribe-mode-map
 
 
 (defvar transcribe-mode-map
-  (let ((map (make-sparse-keymap)))
+   (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "C-x C-p") 'emms-play-file)
     (define-key map (kbd "C-x C-a") 'transcribe-analyze)
     (define-key map (kbd "C-x C-a") 'transcribe-analyze)
+    (define-key map (kbd "C-x C-n") 'NewEpisode)
+    (define-key map (kbd "C-x <down>") 'emms-stop)
+    (define-key map (kbd "C-x <right>") 'emms-seek-forward)
+    (define-key map (kbd "C-x <left>") 'emms-seek-backward)
+    (define-key map (kbd "<f2>") 'transcribe-add-attribute-move)
+    (define-key map (kbd "<f3>") 'transcribe-add-attribute-function)
+    (define-key map (kbd "<f4>") 'transcribe-add-attribute)
+    (define-key map (kbd "<f5>") 'emms-pause)
+    (define-key map (kbd "<f8>") 'emms-seek)
+    (define-key map (kbd "<f9>") 'transcribe-xml-tag)
+    (define-key map (kbd "<f10>") 'transcribe-xml-tag-person)
+    (define-key map (kbd "<f11>") 'transcribe-xml-l1)
+    (define-key map (kbd "<f12>") 'transcribe-xml-l2)
     map)
   "Keymap for Transcribe minor mode.")
 
     map)
   "Keymap for Transcribe minor mode.")
 
     "---"
     ["Analyze" transcribe-analyze]
     ["Analyze all" arbitools-analyze-all]
     "---"
     ["Analyze" transcribe-analyze]
     ["Analyze all" arbitools-analyze-all]
+    "---"
+    ["Add transcription header" NewEpisode]
+    ["Add move attribute" transcribe-add-attribute-move]
+    ["Add function attribute" transcribe-add-attribute-function]
+    ["Add L1 intervention" transcribe-xml-l1]
+    ["Add L2 intervention" transcribe-xml-l2]
+    ["Add move" transcribe-xml-tag-person]
+    "---"
+    ["Play audio file" emms-play-file]
     ))
 
 
     ))
 
 
  "Toggle transcribe-mode"
   nil
   " Trans"
  "Toggle transcribe-mode"
   nil
   " Trans"
-  '(([?\C-x ?\C-p] . emms-play-file)
-    ([?\C-x ?\C-a] . transcribe-analyze)
-    ([?\C-x ?\C-n] . NewEpisode)
-    ([?\C-x down] . emms-stop)
-    ([?\C-x right] . emms-seek-forward)
-    ([?\C-x left] . emms-seek-backward)
-    
-    ([f2] . transcribe-add-attribute-function)
-    ([f3] . transcribe-add-attribute-move)
-    ([f4] . transcribe-add-attribute)
-    
-    ([f5] . emms-pause)
-    ([f8] . emms-seek)
-   
-    ([f9] . transcribe-xml-tag)
-    ([f10] . transcribe-xml-tag-person)
-    ([f11] . transcribe-xml-tag-l1)
-    ([f12] . transcribe-xml-tag-l2))
+  transcribe-mode-map
   (generate-new-buffer "Statistics Output")
   (generate-new-buffer "Raw Output")
   (generate-new-buffer "Statistics Output")
   (generate-new-buffer "Raw Output")
-  (save-excursion
-    (set-buffer "Statistics Output")
+;;  (with-current-buffer "Raw Output"
+;;    (linum-mode t)
+;;    (setq linum-format "%d "))
+  (with-current-buffer "Statistics Output"
     ;; (insert "person,episode,duration,C-UNITS(L2),C-UNITS(L1),role,context,demand,QUAN-L2,QUAN-L1,QUAL-L2,segmented,aux,level,subjects,yearofCLIL,month\n")
   )
   ;; TODO: save the students present in transcription in list so that we can use that list for transcribe-analyze-all
     ;; (insert "person,episode,duration,C-UNITS(L2),C-UNITS(L1),role,context,demand,QUAN-L2,QUAN-L1,QUAL-L2,segmented,aux,level,subjects,yearofCLIL,month\n")
   )
   ;; TODO: save the students present in transcription in list so that we can use that list for transcribe-analyze-all