code.delx.au - gnu-emacs-elpa/blob - packages/transcribe/transcribe.el

   1 ;;; transcribe.el --- Package for audio transcriptions
   2
   3 ;; Copyright 2014-2015  Free Software Foundation, Inc.
   4
   5 ;; Author: David Gonzalez Gandara <dggandara@member.fsf.org>
   6 ;; Version: 1.0.2
   7
   8 ;; This program is free software: you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12 ;;
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17 ;;
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; REQUIRES:
  24 ;; -----------------------------
  25 ;; This module works without any requires, but in order to use the audio
  26 ;; functions, you need to install the emacs package "emms", by Joe Drew,
  27 ;; and the external program "mpg321", by Jorgen Schafer and Ulrik Jensen,
  28 ;; both under GPL licenses.
  29 ;;
  30 ;; USAGE:
  31 ;; -------------------------
  32 ;; Transcribe is a tool to make audio transcriptions. It allows the
  33 ;; transcriber to control the audio easily while typing, as well as
  34 ;; automate the insertion of xml tags, in case the transcription protocol
  35 ;; include them.
  36 ;; The analyse function will search for a specific structure
  37 ;; of episodes that can be automatically added with the macro NewEpisode.
  38 ;; The function expects the speech acts to be transcribed inside a turn xml
  39 ;; tag with the identifier of the speaker with optional move attribute.
  40 ;; Each speech act is spected inside a <l1> or <l2> tag, depending
  41 ;; on the language used by the person. The attributes expected are the
  42 ;; number of clauses that form the utterance, the number of errors the
  43 ;; transcriber observes, and the function of the speech act. The parser will
  44 ;; work even if some attributes are missing.
  45 ;;
  46 ;;
  47 ;; AUDIO COMMANDS
  48 ;; ------------------------------
  49 ;;     C-x C-p ------> Play audio file. You will be prompted for the name
  50 ;;                     of the file. The recommended format is mp2.
  51 ;;     <f5> ---------> Pause or play audio.
  52 ;;     C-x <right> --> seek audio 10 seconds forward.
  53 ;;     C-x <left> --->seek audio 10 seconds backward.
  54 ;;     <f8> ---------> seek interactively: positive seconds go forward and
  55 ;;                       negative seconds go backward
  56 ;;
  57 ;; XML TAGGING COMMANDS
  58 ;; --------------------------------------------------
  59 ;;     C-x C-n ------> Create new episode structure. This is useful in case your
  60 ;;                 xml file structure requires it.
  61 ;;     <f2> ---------> Interactively insert a function attribute in a speech act
  62 ;;                 (l1 or l2) tag.
  63 ;;     <f3> ---------> Interactively insert a move attribute in a turn (person) tag
  64 ;;     <f4> ---------> Interactively insert an attribute (any kind)
  65 ;;     <f9> ---------> Insert turn (person) tag. Inserts a move attribute.
  66 ;;     <f10> --------> Insert a custom tag. Edit the function to adapt to your needs.
  67 ;;     <f11> --------> Insert speech act tag in L1, with clauses, errors and function
  68 ;;                     attributes.
  69 ;;     <f12> --------> Insert speech act tag in L2, with clauses, errors and function
  70 ;;                     attributes.
  71 ;;
  72 ;; AUTOMATIC PARSING
  73 ;; -----------------------------------------------------
  74 ;;     C-x C-a ------> Analyses the text for measurments of performance.
  75
  76 ;;; Code:
  77
  78 (if t (require 'emms-setup))
  79 ;(require 'emms-player-mpd)
  80 ;(setq emms-player-mpd-server-name "localhost")
  81 ;(setq emms-player-mpd-server-port "6600")
  82
  83 (emms-standard)
  84 (emms-default-players)
  85 (if t (require 'emms-player-mpg321-remote))
  86 (defvar emms-player-list)
  87 (push 'emms-player-mpg321-remote emms-player-list)
  88
  89 (if t (require 'emms-mode-line))
  90 (emms-mode-line 1)
  91 (if t (require 'emms-playing-time))
  92 (emms-playing-time 1)
  93
  94 (defvar transcribe-function-list '("initiating" "responding" "control" "expresive" "interpersonal"))
  95 (defvar transcribe-move-list '("initiation" "response" "follow-up"))
  96 (defvar transcribe-attribute-list '("clauses" "errors" "function" "move"))
  97 ;(append transcribe-attribute-list transcribe-function-list transcribe-move-list)
  98
  99 (defun transcribe-analyze-episode (episode person)
 100   "This calls the external python package analyze_episodes2.py. The new
 101    function transcribe-analyze implements its role now."
 102   (interactive "sepisode: \nsperson:")
 103   (shell-command (concat (expand-file-name  "analyze_episodes2.py")
 104                   " -e " episode " -p " person " -i " buffer-file-name )))
 105
 106 (defun transcribe-analyze (episodenumber personid)
 107   "Extract from a given episode and person the number of asunits per
 108    second produced, and the number of clauses per asunits, for L2 and L1."
 109   (interactive "sepisodenumber: \nspersonid:")
 110   (let* ((interventionsl2 '())
 111      (interventionsl1 '())
 112      (xml (xml-parse-region (point-min) (point-max)))
 113      (results (car xml))
 114      (episodes (xml-get-children results 'episode))
 115      (asunitsl2 0.0000)
 116      (asunitsl1 0.0000)
 117      (shifts nil)
 118      (clausesl1 0.0000)
 119      (errorsl1 0.0000)
 120      (clausesl2 0.0000)
 121      (errorsl2 0.0000)
 122      (duration nil)
 123      (number nil))
 124
 125      (dolist (episode episodes)
 126        (let*((numbernode (xml-get-children episode 'number)))
 127
 128          (setq number (nth 2 (car numbernode)))
 129          (when (equal episodenumber number)
 130            (let* ((durationnode (xml-get-children episode 'duration))
 131              (transcription (xml-get-children episode 'transcription)))
 132
 133              (setq duration (nth 2 (car durationnode)))
 134              (dolist (turn transcription)
 135                (let* ((interventionnode (xml-get-children turn
 136                  (intern personid))))
 137
 138                  (dolist (intervention interventionnode)
 139                    (let* ((l2node (xml-get-children intervention 'l2))
 140                      (l1node (xml-get-children intervention 'l1)))
 141
 142                      (dolist (l2turn l2node)
 143                        (let* ((l2 (nth 2 l2turn))
 144                           (clausesl2node (nth 1 l2turn))
 145                           (clausesl2nodeinc (cdr (car clausesl2node))))
 146
 147                           (when (not (equal clausesl2node nil))
 148                             (setq clausesl2 (+ clausesl2 (string-to-number
 149                              clausesl2nodeinc))))
 150                           (when (not (equal l2 nil))
 151                             (add-to-list 'interventionsl2 l2)
 152                             (setq asunitsl2 (1+ asunitsl2)))))
 153                      (dolist (l1turn l1node)
 154                        (let*((l1 (nth 2 l1turn))
 155                          (clausesl1node (nth 1 l1turn))
 156                          (clausesl1nodeinc (cdr (car clausesl1node))))
 157
 158                          (when (not (equal clausesl1node nil))
 159                            (setq clausesl1 (+ clausesl1 (string-to-number
 160                               clausesl1nodeinc))))
 161                          (when (not (equal l1 nil))
 162                            (add-to-list 'interventionsl1 l1)
 163                            (setq asunitsl1 (1+ asunitsl1)))))))))))))
 164   (reverse interventionsl2)
 165   (reverse interventionsl1)
 166   ;(print interventions) ;uncomment to display all the interventions on screen
 167   (let((asunitspersecondl2 (/ asunitsl2 (string-to-number duration)))
 168     (clausesperasunitl2 (/ clausesl2 asunitsl2))
 169     (asunitspersecondl1 (/ asunitsl1 (string-to-number duration)))
 170     (clausesperasunitl1 (/ clausesl1 asunitsl1)))
 171
 172     (princ (format "episode: %s, duration: %s, person: %s\n" episodenumber duration personid))
 173     (princ (format "L2(Asunits/second): %s, L2(clauses/Asunit): %s, L1(Asunits/second): %s"
 174           asunitspersecondl2 clausesperasunitl2 asunitspersecondl1)))))
 175
 176 (defun transcribe-xml-tag-person (xmltag)
 177   "This function allows the automatic insetion of a speaker xml tag and places the cursor."
 178   (interactive "stag:")
 179   (insert (format "<%s move=\"\"></%s>" xmltag xmltag))
 180   (backward-char 3)
 181   (backward-char (string-width xmltag)))
 182
 183 (defun transcribe-xml-tag (xmltag)
 184   "This function allows the automatic insetion of a custom xml tag and places the cursor."
 185   (interactive "stag:")
 186   (insert (format "<%s></%s>" xmltag xmltag))
 187   (backward-char 3)
 188   (backward-char (string-width xmltag)))
 189
 190 (defun transcribe-region-xml-tag (xmltag)
 191   "This function encapsulates the marked region in the given tag."
 192   (interactive "stag:")
 193   (let ((beginning (region-beginning))
 194        (end (region-end)))
 195   (goto-char beginning)
 196   (insert (format "<%s>" xmltag))
 197   (goto-char end)
 198   (insert (format "</%s>" xmltag))))
 199
 200 (defun transcribe-add-attribute (att val)
 201   "Adds a xml attribute at cursor with the name and value specified (autocompletion possible)"
 202   (interactive (list(completing-read "attibute name:" transcribe-attribute-list)(read-string "value:")))
 203   (insert (format "%s=\"%s\"" att val)))
 204
 205 (defun transcribe-add-attribute-function (val)
 206   "Adds the xml attribute 'function' at cursor with the name specified (autocompletion possible)"
 207   (interactive (list(completing-read "function name:" transcribe-function-list)))
 208   (insert (format "function=\"%s\"" val)))
 209
 210 (defun transcribe-add-attribute-move (val)
 211   "Adds the xml attribute 'move' at cursor with the name specified (autocompletion possible"
 212   (interactive (list(completing-read "move name:" transcribe-move-list)))
 213   (insert (format "move=\"%s\"" val)))
 214
 215 (defun transcribe-xml-tag-l1 ()
 216   "Inserts a l1 tag and places the cursor"
 217   (interactive)
 218   (insert "<l1 clauses=\"1\" errors=\"0\" function=\"\"></l1>")
 219   (backward-char 5))
 220
 221 (defun transcribe-xml-tag-l2 ()
 222   "Inserts a l2 tag and places the cursor"
 223   (interactive)
 224   (insert "<l2 clauses=\"1\" errors=\"0\" function=\"\"></l2>")
 225   (backward-char 5))
 226
 227 (defun transcribe-xml-tag-break (xmltag)
 228   "This function breaks an unit into two. That is, insert a closing and an opening equal tags"
 229   (interactive "stag:")
 230   (insert (format "</%s><%s clauses=\"1\" errors=\"0\" function=\"\">" xmltag xmltag)))
 231
 232 (defun transcribe-display-audio-info ()
 233   (interactive)
 234   (emms-player-mpg321-remote-proc)
 235   (shell-command "/usr/bin/mpg321 -R - &"))
 236
 237
 238 (fset 'NewEpisode
 239       "<episode>\n<number>DATE-NUMBER</number>\n<duration></duration>\n<comment></comment>\n<subject>Subject (level)</subject>\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
 240
 241 ;;;###autoload
 242 (define-minor-mode transcribe-mode
 243  "Toggle transcribe-mode"
 244   nil
 245   " Trans"
 246   '(([?\C-x ?\C-p] . emms-play-file)
 247     ([?\C-x ?\C-a] . transcribe-analyze)
 248     ([?\C-x ?\C-n] . NewEpisode)
 249     ([?\C-x down] . emms-stop)
 250     ([?\C-x right] . emms-seek-forward)
 251     ([?\C-x left] . emms-seek-backward)
 252
 253     ([f2] . transcribe-add-attribute-function)
 254     ([f3] . transcribe-add-attribute-move)
 255     ([f4] . transcribe-add-attribute)
 256
 257     ([f5] . emms-pause)
 258     ([f8] . emms-seek)
 259
 260     ([f9] . transcribe-xml-tag)
 261     ([f10] . transcribe-xml-tag-person)
 262     ([f11] . transcribe-xml-tag-l1)
 263     ([f12] . transcribe-xml-tag-l2))
 264 )
 265
 266 (provide 'transcribe)
 267
 268 ;;; transcribe.el ends here