]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/transcribe/transcribe.el
Merge commit '9d4a005a34458419025162224c9daf8d674142c8'
[gnu-emacs-elpa] / packages / transcribe / transcribe.el
index c751bc04bb4f76a039637f37c43b0216628f3208..684e505aa53edc02b7d2e418d7da3cc29f0114ee 100644 (file)
@@ -3,7 +3,7 @@
 ;; Copyright 2014-2015  Free Software Foundation, Inc.
 
 ;; Author: David Gonzalez Gandara <dggandara@member.fsf.org>
-;; Version: 1.0.0
+;; Version: 1.0.2
 
 ;; 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
 
 ;; REQUIRES:
 ;; -----------------------------
-;; In order to use the audio functions of transcribe, you need to install 
-;; emms and mpg321.
+;; 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, 
+;; and the external program "mpg321", by Jorgen Schafer and Ulrik Jensen,
+;; both under GPL licenses.
 ;;
 ;; USAGE:
 ;; -------------------------
 ;; include them.
 ;; The analyse function will search for a specific structure 
 ;; of episodes that can be automatically added with the macro NewEpisode. 
-;; The function expects the utterances to be transcribed inside a xml tag 
-;; with the identifier of the speaker, with the tags <l1> or <l2>, depending 
+;; The function expects the speech acts to be transcribed inside a turn xml 
+;; tag with the identifier of the speaker with optional move attribute.
+;; Each speech act is spected inside a <l1> or <l2> tag, depending 
 ;; on the language used by the person. The attributes expected are the 
-;; number of clauses that form the utterance and the number of errors the 
-;; transcriber observes.
+;; number of clauses that form the utterance, the number of errors the 
+;; transcriber observes, and the function of the speech act. The parser will
+;; work even if some attributes are missing.
 ;; 
 ;; 
 ;; AUDIO COMMANDS
 ;;
 ;; XML TAGGING COMMANDS
 ;; --------------------------------------------------
-;;     C-x C-n --> Create new episode structure. This is useful in case your 
-;;                 xml file structure requires it. You can customize the text 
-;;                 inserted manipulating the realted function.
-;;     <f6> -----> Interactively insert new tag. You will be prompted for the 
-;;                 content of the tag. The starting tag and the end tag will be 
-;;                 inserted automatically and the cursor placed in the proper 
-;;                 place to type.
+;;     C-x C-n ------> Create new episode structure. This is useful in case your 
+;;                 xml file structure requires it.
+;;     <f2> ---------> Interactively insert a function attribute in a speech act 
+;;                 (l1 or l2) tag.
+;;     <f3> ---------> Interactively insert a move attribute in a turn (person) tag
+;;     <f4> ---------> Interactively insert an attribute (any kind)
+;;     <f9> ---------> Insert turn (person) tag. Inserts a move attribute.
+;;     <f10> --------> Insert a custom tag. Edit the function to adapt to your needs.
+;;     <f11> --------> Insert speech act tag in L1, with clauses, errors and function
+;;                     attributes.
+;;     <f12> --------> Insert speech act tag in L2, with clauses, errors and function
+;;                     attributes.
 ;;
-;;
-;;
-;; SPECIFIC COMMANDS I USE, THAT YOU MAY FIND USEFUL
-;; ------------------------------------------------
+;; AUTOMATIC PARSING
+;; -----------------------------------------------------
 ;;     C-x C-a ------> Analyses the text for measurments of performance.
-;;     <f11> --------> Customised tag 1. Edit the function to adapt to your needs.
-;;     <f12> --------> Customised tag 2. Edit the function to adapt to your needs.
-;;     <f7> ---------> Break tag. This command "breaks" a tag in two, that is 
-;;                     it inserts an ending tag and then a starting tag.
-;;     <f4> ---------> Insert atributes. This function insert custom xml attributes. 
-;;                     Edit the function to suit you needs.
 
 ;;; Code:
 
 (if t (require 'emms-playing-time))
 (emms-playing-time 1)
 
+(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)
+
 (defun transcribe-analyze-episode (episode person)
   "This calls the external python package analyze_episodes2.py. The new 
    function transcribe-analyze implements its role now."
   "Extract from a given episode and person the number of asunits per 
    second produced, and the number of clauses per asunits, for L2 and L1."
   (interactive "sepisodenumber: \nspersonid:")
-  (setq interventionsl2 '())
-  (setq interventionsl1 '())
-  (setq xml (xml-parse-region (point-min) (point-max)))
-  (setq results (car xml))
-  (setq episodes (xml-get-children results 'episode))
-  (setq asunitsl2 0.0000)
-  (setq asunitsl1 0.0000)
-  (setq shifts)
-  (setq clausesl1 0.0000)
-  (setq errorsl1 0.0000)
-  (setq clausesl2 0.0000)
-  (setq errorsl2 0.0000)
-  (dolist (episode episodes)
-     (setq numbernode (xml-get-children episode 'number))
-     (setq number (nth 2 (car numbernode)))
-     (when (equal episodenumber number)
-           (setq durationnode (xml-get-children episode 'duration))
-           (setq duration (nth 2 (car durationnode)))
-           (setq transcription (xml-get-children episode 'transcription))
-           (dolist (turn transcription)
-                   (setq interventionnode (xml-get-children turn (intern personid)))
-                   (dolist (intervention interventionnode)
-                           (setq l2node (xml-get-children intervention 'l2))
-                           (dolist (l2turn l2node)
-                                   (setq l2 (nth 2 l2turn))
-                                   (setq clausesl2node (nth 1 l2turn))
-                                   (setq clausesl2nodeinc (cdr (car clausesl2node)))
-                                   (when (not (equal clausesl2node nil))
-                                         (setq clausesl2 (+ clausesl2 
-                                              (string-to-number clausesl2nodeinc))))
-                                   (when (not (equal l2 nil)) 
-                                         (add-to-list 'interventionsl2 l2) 
-                                         (setq asunitsl2 (1+ asunitsl2))))
-                           (setq l1node (xml-get-children intervention 'l1))
-                           (dolist (l1turn l1node)
-                                   (setq l1 (nth 2 l1turn))
-                                   (setq clausesl1node (nth 1 l1turn))
-                                   (setq clausesl1nodeinc (cdr (car clausesl1node)))
-                                   (when (not (equal clausesl1node nil))
-                                         (setq clausesl1 (+ clausesl1 
-                                               (string-to-number clausesl1nodeinc))))
-                                   (when (not (equal l1 nil)) 
-                                         (add-to-list 'interventionsl1 l1) 
-                                         (setq asunitsl1 (1+ asunitsl1))))))))
+  (let* ((interventionsl2 '())
+     (interventionsl1 '())
+     (xml (xml-parse-region (point-min) (point-max)))
+     (results (car xml))
+     (episodes (xml-get-children results 'episode))
+     (asunitsl2 0.0000)
+     (asunitsl1 0.0000)
+     (shifts nil)
+     (clausesl1 0.0000)
+     (errorsl1 0.0000)
+     (clausesl2 0.0000)
+     (errorsl2 0.0000)
+     (duration nil)
+     (number nil))
+         
+     (dolist (episode episodes)
+       (let*((numbernode (xml-get-children episode 'number)))
+                 
+         (setq number (nth 2 (car numbernode)))
+         (when (equal episodenumber number)
+           (let* ((durationnode (xml-get-children episode 'duration))
+             (transcription (xml-get-children episode 'transcription)))
+                       
+             (setq duration (nth 2 (car durationnode)))
+             (dolist (turn transcription)
+               (let* ((interventionnode (xml-get-children turn 
+                 (intern personid))))
+                 
+                 (dolist (intervention interventionnode)
+                   (let* ((l2node (xml-get-children intervention 'l2))
+                     (l1node (xml-get-children intervention 'l1)))
+                       
+                     (dolist (l2turn l2node)
+                       (let* ((l2 (nth 2 l2turn))
+                          (clausesl2node (nth 1 l2turn))
+                          (clausesl2nodeinc (cdr (car clausesl2node))))
+                          
+                          (when (not (equal clausesl2node nil))
+                            (setq clausesl2 (+ clausesl2 (string-to-number 
+                             clausesl2nodeinc))))
+                          (when (not (equal l2 nil)) 
+                            (add-to-list 'interventionsl2 l2) 
+                            (setq asunitsl2 (1+ asunitsl2)))))
+                     (dolist (l1turn l1node)
+                       (let*((l1 (nth 2 l1turn))
+                         (clausesl1node (nth 1 l1turn))
+                         (clausesl1nodeinc (cdr (car clausesl1node))))
+                         
+                         (when (not (equal clausesl1node nil))
+                           (setq clausesl1 (+ clausesl1 (string-to-number 
+                              clausesl1nodeinc))))
+                         (when (not (equal l1 nil)) 
+                           (add-to-list 'interventionsl1 l1) 
+                           (setq asunitsl1 (1+ asunitsl1)))))))))))))
   (reverse interventionsl2)
   (reverse interventionsl1)
   ;(print interventions) ;uncomment to display all the interventions on screen
-  (setq asunitspersecondl2 (/ asunitsl2 (string-to-number duration)))
-  (setq clausesperasunitl2 (/ clausesl2 asunitsl2))
-  (setq asunitspersecondl1 (/ asunitsl1 (string-to-number duration)))
-  (setq clausesperasunitl1 (/ clausesl1 asunitsl1))
-  (princ (format "episode: %s, duration: %s, person: %s\n" number duration personid))
-  (princ (format "L2(Asunits/second): %s, L2(clauses/Asunit): %s, L1(Asunits/second): %s" 
-          asunitspersecondl2 clausesperasunitl2 asunitspersecondl1))
-)
+  (let((asunitspersecondl2 (/ asunitsl2 (string-to-number duration)))
+    (clausesperasunitl2 (/ clausesl2 asunitsl2))
+    (asunitspersecondl1 (/ asunitsl1 (string-to-number duration)))
+    (clausesperasunitl1 (/ clausesl1 asunitsl1)))
+  
+    (princ (format "episode: %s, duration: %s, person: %s\n" episodenumber duration personid))
+    (princ (format "L2(Asunits/second): %s, L2(clauses/Asunit): %s, L1(Asunits/second): %s" 
+          asunitspersecondl2 clausesperasunitl2 asunitspersecondl1)))))
+
+(defun transcribe-xml-tag-person (xmltag)
+  "This function allows the automatic insetion of a speaker xml tag and places the cursor."
+  (interactive "stag:")
+  (insert (format "<%s move=\"\"></%s>" xmltag xmltag))
+  (backward-char 3)
+  (backward-char (string-width xmltag)))
 
-(defun transcribe-define-xml-tag (xmltag)
-  "This function allows the automatic insetion of a xml tag and places the cursor."
+(defun transcribe-xml-tag (xmltag)
+  "This function allows the automatic insetion of a custom xml tag and places the cursor."
   (interactive "stag:")
   (insert (format "<%s></%s>" xmltag xmltag))
   (backward-char 3)
   (backward-char (string-width xmltag)))
 
+(defun transcribe-region-xml-tag (xmltag)
+  "This function encapsulates the marked region in the given tag."
+  (interactive "stag:")
+  (let ((beginning (region-beginning))
+       (end (region-end)))
+  (goto-char beginning)
+  (insert (format "<%s>" xmltag))
+  (goto-char end)
+  (insert (format "</%s>" xmltag))))
+
+(defun transcribe-add-attribute (att val)
+  "Adds a xml attribute at cursor with the name and value specified (autocompletion possible)"
+  (interactive (list(completing-read "attibute name:" transcribe-attribute-list)(read-string "value:"))) 
+  (insert (format "%s=\"%s\"" att val)))
+
+(defun transcribe-add-attribute-function (val)
+  "Adds the xml attribute 'function' at cursor with the name specified (autocompletion possible)"
+  (interactive (list(completing-read "function name:" transcribe-function-list))) 
+  (insert (format "function=\"%s\"" val)))
+
+(defun transcribe-add-attribute-move (val)
+  "Adds the xml attribute 'move' at cursor with the name specified (autocompletion possible"
+  (interactive (list(completing-read "move name:" transcribe-move-list))) 
+  (insert (format "move=\"%s\"" val)))
+
 (defun transcribe-xml-tag-l1 ()
   "Inserts a l1 tag and places the cursor"
   (interactive)
-  (insert "<l1></l1>")
-  (backward-char 3)
-  (backward-char 2))
+  (insert "<l1 clauses=\"1\" errors=\"0\" function=\"\"></l1>")
+  (backward-char 5))
 
 (defun transcribe-xml-tag-l2 ()
   "Inserts a l2 tag and places the cursor"
   (interactive)
-  (insert "<l2 clauses=\"1\" errors=\"0\"></l2>")
-  (backward-char 3)
-  (backward-char 2))
+  (insert "<l2 clauses=\"1\" errors=\"0\" function=\"\"></l2>")
+  (backward-char 5))
 
-(fset 'transcribe-xml-tag-l2-break "</l2><l2 clauses=\"1\" errors=\"0\">")
-   ;inserts a break inside a l2 tag
-(fset 'transcribe-set-attributes "clauses=\"1\" errors=\"0\"")
-    ;inserts the attributes where they are missing
+(defun transcribe-xml-tag-break (xmltag)
+  "This function breaks an unit into two. That is, insert a closing and an opening equal tags"
+  (interactive "stag:")
+  (insert (format "</%s><%s clauses=\"1\" errors=\"0\" function=\"\">" xmltag xmltag)))
 
 (defun transcribe-display-audio-info ()
   (interactive)
     ([?\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)
-    ([f6] . transcribe-define-xml-tag)
-    ([f7] . transcribe-xml-tag-l2-break)
     ([f8] . emms-seek)
-    ([f4] . transcribe-set-atributes)
+   
+    ([f9] . transcribe-xml-tag)
+    ([f10] . transcribe-xml-tag-person)
     ([f11] . transcribe-xml-tag-l1)
     ([f12] . transcribe-xml-tag-l2))
 )