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