;;; annotate.el --- annotation helper functions.
;; Copyright 2007 by Martin Howse
;; $Revision: 1.2 $
;; annotate.el is free software distributed under the terms of the GNU General
;; Public Licence, version 3. For details see the file COPYING.
;; TODO:
;; / fix up GR copy - backlinks and better linking - improved search
;; - 2] links/tags and inheritance structuring // further markup. - some
;; - is in place - saving KR worlds
;; - 4] further integration with version control/RCS check in and check
;; - out / auto-save annotation file. co when annotate starts checkin on exit
;; DOCUMENTATION
;; briefly for org-mode: [TAB] cycles headings, C-c C-o - visit link at point
;; formatting:
;; P: [page and line [if known]] - must be matched with poor online text copy P: 415.22
;; b: [start word]
;; e: [end word] - if we don't have page reference then we need to search
;; start and end word proximity
;; c: [categories/link/KR data] - suggested categories separated with ,[space]
;; t: [annotation] - or from marked text
(require 'pilot)
(require 'org)
;; for org-mode:
(setq org-return-follows-link t)
(defconst number-regexp
"-?\\([0-9]+\\.?\\|\\.\\)[0-9]*\\(e[0-9]+\\)?"
"Regular expression for recognizing numbers.")
(defvar annotation-types
'(("text" "t:") ("video" "f:") ("scratch" "s:") ("image" "i:") ("audio" "a:") ("process" "p:") ("code" "k:"))
"The available annotation types.")
(defvar annotation-default-type "text"
"The default annotation type.")
(defvar default-file-name "/root/experiment/lifecode/GravitysRainbow.txt")
(defvar default-annotation-file-name "/root/experiment/GR/autotate")
(defvar default-ratio 5)
(defvar pilot-device "/dev/ttyUSB0")
(defun palm-ann ()
;; enter palm memo into buffer
(interactive)
(save-excursion
(let ((buf (set-buffer (get-buffer-create "**pilot**"))))
(erase-buffer)
(pilot-run-command (format "pilot-memos -c GR -p /dev/ttyUSB0")
"Press the HotSync button now to import annotations." t)
(message "Done.")
;; get rid of From Palm.Handheld to Subject (next line)
(beginning-of-buffer)
(while (re-search-forward "From Palm.Handheld" nil t)
(beginning-of-line)
(setq ptr (point))
(re-search-forward "Subject" nil t)
(next-line 1)
(delete-region ptr (point)))
(annotate_buffer))))
(defun annotate_region (rb re)
;; make annotations from a region marked as p: type as default b: e:
;; c: and with t: marking beginning of text block
;; start of region
(interactive "r")
(let ((type annotation-default-type))
(save-excursion
(save-restriction
(narrow-to-region rb re)
(goto-char (point-min))
(search-forward "P: ")
(setq inter-page (subseq (thing-at-point 'sentence) 3))
;; split on the .
(setq page (first (split-string inter-page "\\.")))
(setq line_number (second (split-string inter-page "\\.")))
(search-forward "b: ") ;; snip first three characters
(setq begin_word (subseq (thing-at-point 'sentence) 3))
(search-forward "e: ") ;; snip first three characters
(setq end_word (subseq (thing-at-point 'sentence) 3))
(search-forward "c: ") ;; snip first three characters
(setq category_list (subseq (thing-at-point 'sentence) 3)) ;; whitespace??
(search-forward "t: ")
(setq text (buffer-substring (point) (point-max)))
(annotate-all page line_number text type category_list begin_word end_word)))))
(defun annotate_buffer ()
(interactive)
(beginning-of-buffer)
(while (re-search-forward "P: " nil t)
(setq ptt (- (point) 3))
(if (re-search-forward "P: " nil t)
(progn
(previous-line 1)
(setq pttt (point)))
(setq pttt (point-max)))
(annotate_region ptt pttt))) ;; to be tested
(defun annotate_template ()
(interactive)
(insert (format "\nP: \n\nb: \n\ne: \n\nc: \n\nt: \n"))
(re-search-backward "P: ")
(goto-char (+ 3 (point))))
(defun inter_annotate ()
(interactive)
(let ((inter-page (read-string "Page: " nil nil "" t))
(type (completing-read
(concat "Type (" annotation-default-type "): ") ;; prompt
annotation-types ;; alist used for completion
nil ;; limiting completion to a subset of
;; `annotation-types' is not done
t ;; only input from `annotation-types' or null
;; is allowed
nil ;; no initial input inserted into minibuffer
nil ;; no history list is used for input
annotation-default-type ;; the default value
t))
(begin_word (read-string "First word: " nil nil "" t))
(end_word (read-string "Last word: " nil nil "" t))
(category_list (read-string "Categories: " nil nil "" t))
;; text as marked region
(text (delete-and-extract-region (region-beginning) (region-end))))))
(defun strip-html ()
"Remove HTML tags from the current buffer,
(this will affect the whole buffer regardless of the restrictions in effect)."
(interactive "*")
(save-excursion
;; (save-restriction
;; (widen)
(goto-char (point-min))
(while (re-search-forward "<[^<]*>" (point-max) t)
(replace-match "\\1"))
(goto-char (point-min))
(replace-string "©" "(c)")
(goto-char (point-min))
(replace-string "&" "&")
(goto-char (point-min))
(replace-string "<" "<")
(goto-char (point-min))
(replace-string ">" ">")
(goto-char (point-min))
(replace-string """ "'")
(goto-char (point-min))
(replace-string "" "'")
(goto-char (point-min))
(replace-string " " "")
(goto-char (point-min))))
(defun annotate_benteague ()
(interactive)
;; http://www.benteague.com/books/titles/gravitys.html
(strip-html)
(goto-char (point-min))
(while
(re-search-forward "^\\(V\\|*V\\)\\([0-9]+\\.[0-9]+\\)" nil t)
(setq inter-page (buffer-substring (match-beginning 2) (point)))
(setq page (first (split-string inter-page "\\.")))
(setq line_number (second (split-string inter-page "\\.")))
(let ((type "text-benteague")
(category_list "")
(begin_word
(progn
;; forward till we reach a letter
(re-search-forward "[a-z]")
(setq pt (- (point) 1))
(re-search-forward ":" nil t)
(buffer-substring pt (- (point) 1))))
(end_word " ")
(text
(progn
;; until next ^V
(setq pt (point))
(if (re-search-forward "^\\(V\\|*V\\)[0-9]+\\.[0-9]+" nil t)
(progn
(previous-line 1)
(beginning-of-line)
(formatted (buffer-substring pt (point))))
(progn
(re-search-forward "^Top")
(previous-line 1)
(beginning-of-line)
(formatted (buffer-substring pt (point))))))))
(annotate-all page line_number text type category_list begin_word end_word)
(switch-to-buffer (other-buffer)))))
(defun formatted (text)
(progn
(let ((buffer (get-buffer-create "*GR temp*")))
(set-buffer buffer)
(insert text)
(fill-region (point-min) (point-max) nil t)
(setq text (buffer-substring (point-min) (- (point-max) 1)))
(kill-buffer buffer)
text)))
(defun annotate_larsson ()
(interactive)
;; http://english2.mnsu.edu/larsson/grnotes.html
;; format:
; Vxxx.xx quotation // or *V always at start of line
; text [next line]
;; note in both cases line number may have dash
(strip-html)
(goto-char (point-min))
(while
(re-search-forward "^\\(V\\|*V\\)\\([0-9]+\\.[0-9]+\\)" nil t)
(setq inter-page (buffer-substring (match-beginning 2) (point)))
(setq page (first (split-string inter-page "\\.")))
(setq line_number (second (split-string inter-page "\\.")))
(let ((type "text-larsson")
(category_list "")
(begin_word
(progn
;; forward till we reach a letter
(re-search-forward "[a-z]")
(setq pt (- (point) 1))
(buffer-substring pt (line-end-position))))
(end_word " ")
(text
(progn
;; until next ^V
(next-line)
(beginning-of-line)
(setq pt (point))
(if (re-search-forward "^\\(V\\|*V\\)[0-9]+\\.[0-9]+" nil t)
(progn
(previous-line 1)
(beginning-of-line)
(formatted (buffer-substring pt (point))))
(progn
(re-search-forward "FEEDBACK")
(previous-line 1)
(beginning-of-line)
(formatted (buffer-substring pt (point))))))))
(annotate-all page line_number text type category_list begin_word end_word)
(switch-to-buffer (other-buffer)))))
(defun annotate_hyperarts ()
(interactive)
(goto-char (point-min))
;; conceptual notes//no line numbers//some kind of hyperlinking scheme
;; parse also extra entries
(while (re-search-forward "" nil t)
;; (setq st (point))
;; (re-search-forward "
")
;; (setq end (- (point) 4))
;; (narrow-to-region st end)
(let ((category_list (progn
(setq st (point))
(re-search-forward "" nil t)
(setq pt (point))
(narrow-to-region st (point))
(strip-html)
(widen)
(setq category_list (buffer-substring st (- pt 5)))))
(type "text-hyper")
(page (progn
(re-search-forward "" nil t)
(setq ppp (point))
(re-search-forward "[0-9]+;" nil t)
(re-search-backward " \\|>")
(goto-char (+ (point) 1))
(matcherz)))
(begin_word category_list)
(end_word " ")
(text (progn
;; (setq st (+ (point) 2))
(re-search-forward "
")
(buffer-substring ppp (- (point) 3)))))
(setq text (re-work-text text))
(annotate-all page "0" text type category_list begin_word end_word)
(switch-to-buffer (other-buffer)))))
(defun re-work-text (text)
;; work on text to turn page numbers into links and transform
;; stuff like: See also Metatron ptt pttt)
(progn
(setq ptttt pttt)
(buffer-substring pt pttt))
(progn
(setq ptttt ptt)
(buffer-substring pt ptt))))))
(annotate-all page line_number text type category_list begin_word end_word)
(switch-to-buffer (other-buffer))
(if (= flag 1)
(goto-char (point-max))
(goto-char ptttt)))))
(defun page-exists (page)
(if (re-search-forward (format "Page: %s " page) nil t)
t
nil))
(defun make-annotation (heading page line_number text type category_list begin_word end_word)
;; deal with heading
(if (= heading 1) ;;
(progn
(insert (format "\n** page: %d\n\n" (string-to-number page)))
(if (= (string-to-number line_number) 0)
(progn
(insert (format "*** noline/concept :%s:\n:PROPERTIES:\n:cat:%s\n:type:%s\n:END:\n" (mapconcat (lambda (x) (subseq x 1)) (split-string (concat " " category_list) ",") ":") category_list type))
(insert (format "\n %s \n"text))
(insert (format "\Phrase: \n %s \n" begin_word))
(insert-link page begin_word end_word))
(progn
(insert (format "*** line: %s :%s\n:PROPERTIES:\n:cat:%s\n:type:%s\n:END:\n" line_number (mapconcat (lambda (x) (subseq x 1)) (split-string (concat " " category_list) ",") ":") category_list type))
(insert (format "\n %s \n"text))
(insert (format "\Phrase: \n %s \n" begin_word))
(insert-link page begin_word end_word))))
(if (= (string-to-number line_number) 0)
(progn
(insert (format "*** noline/concept :%s:\n:PROPERTIES:\n:cat:%s\n:type:%s\n:END:\n" (mapconcat (lambda (x) (subseq x 1)) (split-string (concat " " category_list) ",") ":") category_list type))
(insert (format "\n %s \n"text))
(insert (format "\Phrase: \n %s \n" begin_word))
(insert-link page begin_word end_word))
(progn
(insert (format "*** line: %s :%s\n:PROPERTIES:\n:cat:%s\n:type:%s\n:END:\n" line_number (mapconcat (lambda (x) (subseq x 1)) (split-string (concat " " category_list) ",") ":") category_list type))
(insert (format "\n %s \n"text))
(insert (format "\Phrase: \n %s \n" begin_word))
(insert-link page begin_word end_word)))))
(defun annotate-all (page line_number text type category_list begin_word end_word)
;; main annotation function
;; place in correct place according only to page number - also maybe
;; goto start and jump page numbers till we can insert
(switch-to-buffer (find-file-noselect default-annotation-file-name))
(goto-char (point-min))
;; does page exist, if not make page heading in right place and enter annotation
;; no pages exist
(if (not (search-forward "Page: " nil t))
(make-annotation 1 page line_number text type category_list begin_word end_word)
(progn
(goto-char (point-min))
;; first_page
(progn
(goto-char (point-min))
(if (and (search-forward "Page: " nil t) (< (string-to-number page) (setq mmmm (matcher))))
;; first page
(progn
(goto-char (point-min))
(make-annotation 1 page line_number text type category_list begin_word end_word))
;; if it does and line_number is 0 then write to the end
(progn
(goto-char (point-min))
(if (= (find-next-number page) 1)
(progn
(jump-to-end)
(make-annotation 1 page line_number text type category_list begin_word end_word))
(if (= (string-to-number line_number) 0)
;; dump at end
(progn
(jump-to-end)
(make-annotation 0 page line_number text type category_list begin_word end_word))
;; otherwise find line number and enter
(progn
(find-line-number line_number)
(make-annotation 0 page line_number text type category_list begin_word end_word))))))))))
;;(annotate-all "223" "5" "____xxxxx" "text" "prison, pain" "He watches" "low hill")
(defun find-line-number (number)
;; no other lines
;; line one
(setq pt (point))
(jump-to-end)
(narrow-to-region (point) pt)
(goto-char (point-min))
;; there is no line numbers so far
(if (not (search-forward "Line: " nil t))
(progn
(goto-char (point-min))
(next-line 1)
(widen))
(progn
(goto-char (point-min))
(if (and (search-forward "Line: " nil t) (< (string-to-number number) (setq mmmm (matcher))))
;; first line
(progn
(goto-char pt)
(next-line 2)
(beginning-of-line)
(widen))
(while (and (search-forward "Line: " nil t) (>= (string-to-number number) (setq mmmm (matcher))))
(setq pt (point)))
(goto-char pt)
(jump-to-end-link)
(widen)))))
(defun deletefront (start end)
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
(while (not (eobp))
(setq ppp (point))
(skip-chars-forward " ")
(delete-region ppp (point))
(forward-line)))))
(defun find-next-number (page)
(while (and (search-forward "Page: " nil t) (>= (string-to-number page) (setq mmmm (matcher))))
(progn
(setq mmmmm mmmm)
(setq pt (point))))
(if (= (string-to-number page) mmmmm)
(progn
(goto-char pt)
2)
(progn
(goto-char pt)
1)))
(defun matcher ()
(let (string)
(if (looking-at number-regexp)
(goto-char (match-end 0)))
(setq string (buffer-substring (match-beginning 0) (point)))
(string-to-number string)))
(defun matcherz ()
(let (string)
(if (looking-at number-regexp)
(goto-char (match-end 0)))
(setq string (buffer-substring (match-beginning 0) (point)))
string))
(defun jump-to-end ()
;; jump to end of text block - how?
(if (re-search-forward "Page: " (point-max) t)
(previous-line 1)
(progn
(goto-char (point-max)))))
(defun jump-to-end-link ()
(if (re-search-forward "Link:" (point-max) t)
(progn
(next-line)
(beginning-of-line))
t))
(defun insert-link (page begin_word end-word)
;; lookup page and place
(let ((realpoint (find-page default-file-name page begin_word end_word)))
;; insert link to this LINE NUMBER in the default file - org-mode
;; eg. [[file:~/code/main.c::255]]
(set-buffer (get-file-buffer default-annotation-file-name))
(insert (format "\\\Link: [[file:%s::%d][page:%d]]\n"
default-file-name realpoint (string-to-number page)))))
(defvar range 200)
(defun find-page (file page begin_word end_word)
;; open file/buffer
(set-buffer (find-file-noselect file))
;; goto-approx line number
;; (goto-line 0)
(goto-line (line-calc page))
(while (and
(setq startpoint (search-forward begin_word nil t))
(setq endpoint (search-forward end_word nil t))
(< endpoint startpoint)
(< range (- endpoint startpoint)))
(goto-char startpoint))
(if (and startpoint endpoint)
;; return line number
(progn
;; (set-buffer (get-file-buffer default-annotation-file-name))
(line-number startpoint))
0))
(defun line-number (pointy)
(line-number-at-pos pointy))
(defun line-calc (page)
(truncate (* (string-to-number page) default-ratio)))
(defun make-regex (word)
(regexp-quote word))
;;(find-page default-file-name "536" "Osbie has" "is waiting")
;;(find-page default-file-name "457" "On shore," "own substance.")
;;(find-page default-file-name "348" "Results have" "desire it.")