[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[ELPA-diffs] /srv/bzr/emacs/elpa r156: new package djvu.el
|
From: |
Roland Winkler |
|
Subject: |
[ELPA-diffs] /srv/bzr/emacs/elpa r156: new package djvu.el |
|
Date: |
Sat, 29 Oct 2011 22:01:56 -0500 |
|
User-agent: |
Bazaar (2.3.1) |
------------------------------------------------------------
revno: 156
committer: Roland Winkler <address@hidden>
branch nick: elpa
timestamp: Sat 2011-10-29 22:01:56 -0500
message:
new package djvu.el
added:
packages/djvu/
packages/djvu/djvu.el
=== added directory 'packages/djvu'
=== added file 'packages/djvu/djvu.el'
--- a/packages/djvu/djvu.el 1970-01-01 00:00:00 +0000
+++ b/packages/djvu/djvu.el 2011-10-30 03:01:56 +0000
@@ -0,0 +1,1630 @@
+;;; djvu.el --- edit and view Djvu files via djvused
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Roland Winkler <address@hidden>
+;; Keywords: files, wp
+;; Version: 0.5
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; djvu.el is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with djvu.el. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary
+
+;; djvu.el is a front end for the command-line program djvused
+;; from DjVuLibre, see http://djvu.sourceforge.net/
+;;
+;; This code requires you have the programs djvused, djview, and ddjvu
+;; installed.
+;;
+;; A normal work flow is as follows:
+;;
+;; To visit a djvu file use `fjvu-find-file'. This command is the
+;; only entry point to this package. You may want to bind this command
+;; to a key you like. I use
+;;
+;; (global-set-key "\C-cd" 'djvu-find-file)
+;;
+;; If you use this command to visit file foo.djvu, it puts you into the
+;; (not editable) buffer address@hidden Normally, this buffer is all you
+;; need.
+;;
+;; The menu bar of this buffer lists most of the commands with their
+;; repsective key bindings. For example, you can:
+;;
+;; - Use `g' to go to the page you want. (Yes, this package operates on
+;; one page at a time. I guess that anything else would be too slow
+;; for large documents.)
+;;
+;; - Use `v' to (re)start djview using the position in foo.djvu
+;; matching where point is in address@hidden (I find djview fast enough
+;; for this, even for larger documents.)
+;;
+;; - To highlight a region in foo.djvu mark the corresponding region in
+;; address@hidden (as usual, `transient-mark-mode' comes handy for this).
+;; Then type `h' and add a comment in the minibuffer if you like.
+;; Type C-x C-s to save this editing. Then type `v' to (re)start
+;; djview to show what you have done.
+;;
+;; - Type i to enable `djvu-image-mode', a minor mode displaying the
+;; current page as an image. Then
+;; drag-mouse-1 defines a region where to put a comment,
+;; C-drag-mouse-1 defines a region where to put a pushpin comment,
+;; S-drag-mouse-1 defines a region to highlight
+;;
+;; - The editing of the text, annotation and outline (bookmark) layers
+;; really happens in the buffers address@hidden, address@hidden, and
+;; address@hidden (The djvused syntax used in these buffers is so
+;; close to elisp that it was natural to give these buffers a
+;; djvu-edit-mode that is derived from emacs-lisp-mode.)
+;;
+;; You can check what is happening by switching to these buffers. The
+;; respective switching commands put point in these buffers such that
+;; it matches where you were in address@hidden
+;;
+;; In these buffers, the menu bar lists a few low-level commands
+;; available for editing these buffers directly. If you know the
+;; djvused syntax, sometimes it can also be helpful to do such
+;; editing "by hand".
+;;
+;; But wait: The syntax in the annotations buffer address@hidden is a
+;; slightly modified djvused syntax. djvused can only highlight
+;; rectangles. So the highlighting of larger regions of text must
+;; use multiple rectangles (i.e., multiple djvused "mapareas").
+;; To make editing easier, these are combined in the buffer address@hidden
+;; (Before saving these things, they are converted using the proper
+;; djvused syntax.)
+;;
+;; When you visit a djvu file, djvu-mode recognizes mapareas
+;; belonging together by checking that "everything else in these
+;; mapareas except for the rects" is the same. So if you entered a
+;; (unique) comment, this allows djvu-mode to combine all the
+;; mapareas when you visit such a file the second time. Without a
+;; comment, this fails!
+;;
+;; A second difference between what is displayed in the djvu buffers
+;; and the input/output of djvused refers to nonascii characters.
+;; I am using djvused from DjVuLibre-3.5.22 which handles utf-8 by
+;; backslash sequences. So djvu mode converts these backslash
+;; sequences into the corresponding utf-8 characters. (More recent
+;; versions of djvused can do this conversion, too.)
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Djvu internals:
+;; (see /usr/share/doc/libdjvulibre-dev/djvu3spec.djvu)
+;;
+;; Area attribute rect oval poly line text
+;; (none)/(xor)/(border c) X X X X X
+;; (shadow_* t) X
+;; (border_avis) X X X
+;; (hilite color) / (opacity o) X
+;; (arrow) / (width w) / (lineclr c) X
+;; (backclr c) / (textclr c) / (pushpin) X
+;;
+;; c = #RRGGBB t = thickness (1..32)
+;; o = opacity = 0..100
+
+;;; Code
+
+(defvar djvu-color-highlight "yellow"
+ "Default color for highlighting.")
+
+(defvar djvu-color-himark "red"
+ "Default color for highmarking.")
+
+(defvar djvu-color-url "blue"
+ "Default color for URLs.")
+
+(defvar djvu-color-background "white"
+ "Default background.")
+
+(defvar djvu-color-alist
+ ;; If the keys are strings, they are directly compatible with what
+ ;; we get back from something like `completing-read'.
+ '(("red" . "#FF0070")
+ ("green" . "#00FF00")
+ ("blue" . "#6666FF")
+ ("yellow" . "#EEFF00")
+ ("white" . "#FFFFFF"))
+ "Alist of colors for highlighting.")
+
+(defvar djvu-opacity 50
+ "Default opacity for Highlighting.")
+
+(defvar djvu-coords-justify 0.02
+ "Upper threshold for justifying rect coordinates.")
+
+(defvar djvu-fill-column 50
+ "Fill column for Djvu annotations.")
+
+(defvar djvu-all-buffer "*djvu*"
+ "Buffer for `all' operations.")
+
+(defvar djvu-buffer-name-extensions
+ '("@djvu" "@djvu-t.el" "@djvu-a.el" "@djvu-o.el")
+ "Extensions for Djvu buffer names.
+This is a list with four elements (READ TEXT ANNOT OUTLINE).")
+
+(defvar djvu-resolve-url nil
+ "Flag for resolving internal URLs.
+If 'long replace short page numbers by long FileIDs.
+If 'short replace long FileIDs by short page numbers.
+If nil do nothing.")
+
+(defvar djvu-image-size 1024
+ "Size of internally displayed image.")
+
+;; Internal variables
+
+(defvar djvu-test nil
+ "If non-nil do not process / delete djvused scripts.")
+;; (setq djvu-test t) (setq djvu-test nil)
+
+(defvar djvu-doc nil
+ "Internal look-up table (a vector) for each Djvu document.
+For the different buffers of one Djvu document the buffer-local
+value of this variable is the same vector holding all the
+relevant information about this document. This way, we obtain a
+\"document-local\" variable, where changes are seen in all buffers
+refering to this Djvu document.")
+(make-variable-buffer-local 'djvu-doc)
+
+;;; Helper functions
+
+;; "read" refers to the text-only display of djvu files inside emacs
+;; "view" refers to external graphical viewers (default djview)
+
+(eval-and-compile
+ (let ((count 0))
+ (dolist (elt '(file basename text-buf read-buf annot-buf outline-buf
+ page pagemax page-id pagesize pos view-proc image))
+ (eval (list 'defsubst (intern (concat "djvu-doc-" (symbol-name elt)))
+ '(&optional doc) `(aref (or doc djvu-doc) ,count)))
+ (eval (list 'defsubst (intern (concat "djvu-doc-set-" (symbol-name elt)))
+ '(val &optional doc) `(aset (or doc djvu-doc) ,count val)))
+ (setq count (1+ count)))
+ (eval `(defconst djvu-doc-length ,count))))
+
+(defun djvu-switch-text ()
+ "Switch to Djvu Text buffer."
+ (interactive)
+ (let ((pos (djvu-read-pos)))
+ (switch-to-buffer (djvu-doc-text-buf))
+ (djvu-locate-pos 'word pos)))
+
+(defun djvu-switch-annot ()
+ "Switch to Djvu Annotations buffer."
+ (interactive)
+ (let ((pos (djvu-read-pos)))
+ (switch-to-buffer (djvu-doc-annot-buf))
+ (djvu-locate-pos 'rect pos)))
+
+(defun djvu-switch-outline ()
+ "Switch to Djvu Outline buffer."
+ (interactive)
+ ;; Try to locate the current page in the outline buffer.
+ ;; If this page is not defined, try to locate the nearest preceding page.
+ (let ((page (djvu-doc-page)) pnt)
+ (with-current-buffer (djvu-doc-outline-buf)
+ (goto-char (point-min))
+ (if (looking-at "(bookmarks")
+ (while (and (< 0 page)
+ (not (setq pnt (re-search-forward
+ (format "\"#%d\"" page) nil t))))
+ (setq page (1- page)))))
+ (switch-to-buffer (djvu-doc-outline-buf))
+ (if pnt (goto-char pnt))))
+
+(defun djvu-switch-read ()
+ "Switch to Djvu Read buffer."
+ (interactive)
+ (switch-to-buffer (djvu-doc-read-buf)))
+
+(defun djvu-goto-page (page)
+ "Goto PAGE of Djvu document."
+ (interactive
+ (let ((str (read-string (format "Page (f, 1-%d, l): " (djvu-doc-pagemax)))))
+ (list (cond ((string-match "\\`f" str) 1)
+ ((string-match "\\`l" str) (djvu-doc-pagemax))
+ ((string-match "\\`[[:digit:]]+\\'" str)
+ (string-to-number str))
+ (t (error "Page `%s' invalid" str))))))
+ (if (or (not (integerp page))
+ (<= page 0) (< (djvu-doc-pagemax) page))
+ (error "Page `%s' out of range" page))
+ (djvu-init-page djvu-doc page))
+
+(defun djvu-next-page (n)
+ (interactive "p")
+ (djvu-goto-page (+ (djvu-doc-page) n)))
+
+(defun djvu-prev-page (n)
+ (interactive "p")
+ (djvu-goto-page (- (djvu-doc-page) n)))
+
+(defun djvu-set-color-highlight (color)
+ "Set color for highlighting based on `djvu-color-alist'."
+ (interactive (list (completing-read "Color: " djvu-color-alist nil t)))
+ (setq djvu-color-highlight color))
+
+(defun djvu-kill-view ()
+ (when (djvu-doc-view-proc)
+ (unless (memq (process-status (djvu-doc-view-proc))
+ '(exit signal))
+ (kill-process (djvu-doc-view-proc)))
+ (djvu-doc-set-view-proc nil)))
+
+(defun djvu-kill-doc ()
+ (interactive)
+ (djvu-save nil t)
+ (djvu-kill-view)
+ (mapc 'kill-buffer (list (djvu-doc-text-buf) (djvu-doc-read-buf)
+ (djvu-doc-annot-buf) (djvu-doc-outline-buf))))
+
+(defsubst djvu-delete-file (script)
+ (unless djvu-test (delete-file script)))
+
+(defun djvu-save (&optional doc query)
+ "Save Djvu DOC."
+ (interactive)
+ (let ((pos (djvu-read-pos))
+ (text-modified (buffer-modified-p (djvu-doc-text-buf doc)))
+ (annot-modified (buffer-modified-p (djvu-doc-annot-buf doc)))
+ (outline-modified (buffer-modified-p (djvu-doc-outline-buf doc)))
+ script)
+ (when (and (or text-modified annot-modified outline-modified)
+ (or (not query)
+ (yes-or-no-p (format "Save %s? " (djvu-doc-basename doc)))))
+ (unwind-protect
+ (progn
+ (setq script (make-temp-file "djvu-el-"))
+ (if text-modified (djvu-process-text script doc))
+ (if annot-modified (djvu-process-annot script doc))
+ (if outline-modified (djvu-process-outline script doc))
+ (djvu-djvused doc nil "-f" script "-s")
+ (dolist (buf (list (djvu-doc-text-buf doc) (djvu-doc-annot-buf doc)
+ (djvu-doc-outline-buf doc) (djvu-doc-read-buf
doc)))
+ (with-current-buffer buf (set-buffer-modified-p nil)))
+ (if text-modified (djvu-locate-read-pos pos)))
+ (djvu-delete-file script)))))
+
+(defun djvu-modified ()
+ "Mark Djvu Read buffer as modified if necessary.
+Used in `post-command-hook' of the Djvu Outline, Text and Read buffers."
+ (with-current-buffer (djvu-doc-read-buf)
+ (set-buffer-modified-p (or (buffer-modified-p (djvu-doc-outline-buf))
+ (buffer-modified-p (djvu-doc-text-buf))
+ (buffer-modified-p (djvu-doc-annot-buf))))))
+
+(defun djvu-process (&optional doc view)
+ "Process Djvu DOC."
+ (interactive (list djvu-doc t))
+ (djvu-save doc)
+ (if view (djvu-view doc)))
+
+(defun djvu-djvused (doc buffer &rest args)
+ ;; BUFFER is nil if we update the Djvu file.
+ (unless (or buffer (file-writable-p (djvu-doc-file doc)))
+ (error "File `%s' not writable"
+ (abbreviate-file-name (djvu-doc-file doc))))
+ (unless (and (not buffer) djvu-test)
+ (let ((status (apply 'call-process "djvused" nil buffer nil
+ (djvu-doc-file doc) args)))
+ (unless (zerop status)
+ (error "Djvused error %s (args: %s)" status args)))))
+
+(defun djvu-hide-hash (&optional recover)
+ (let* ((old (concat " " (if recover "@!@" "#") "\\([[:xdigit:]]\\)"))
+ (new (concat " " (if recover "#" "@!@") "\\1")))
+ (goto-char (point-min))
+ (while (re-search-forward old nil t) (replace-match new))))
+
+(defun djvu-interactive-region ()
+ "Return active region for use in interactive calls."
+ (let (beg end)
+ (if (use-region-p)
+ (setq beg (region-beginning)
+ end (region-end))
+ (setq beg (point) end (1+ (point))))
+ (cons (if (get-text-property beg 'word)
+ (djvu-property-beg beg 'word)
+ (next-single-property-change beg 'word nil end))
+ (if (get-text-property (1- end) 'word)
+ (djvu-property-end end 'word)
+ (previous-single-property-change end 'word nil beg)))))
+
+(defun djvu-interactive-color (color)
+ "Return color specification for use in interactive calls."
+ (let ((colnum (or (and (consp current-prefix-arg)
+ (1- (/ (car current-prefix-arg) 4)))
+ (and (integerp current-prefix-arg)
+ current-prefix-arg))))
+ (if (and colnum (>= colnum (length djvu-color-alist)))
+ (error "Color undefined"))
+ (if colnum (car (nth colnum djvu-color-alist)) color)))
+
+(defun djvu-interactive-url (&optional color interrupt)
+ "Return URL specification for use in interactive calls."
+ (unless color (setq color djvu-color-url))
+ (let ((fmt (format "(%s) Page URL: " (or color djvu-color-url)))
+ (page "") num ignore)
+ (while (and (not ignore)
+ (or (not (integerp (setq num (string-to-number page))))
+ (< num 1) (< (djvu-doc-pagemax) num)))
+ (setq page (read-string fmt))
+ (if (and interrupt (string= "" page)) (setq ignore t)))
+ (unless ignore (concat "#" page))))
+
+(defsubst djvu-color-string-to-hex (color i)
+ "Convert rgb COLOR string (part I) to hex number."
+ (string-to-number (substring-no-properties
+ (cdr (assoc color djvu-color-alist))
+ (1+ (* i 2)) (+ 3 (* i 2))) 16))
+
+(defun djvu-color-background (color background opacity)
+ "For rgb COLOR and BACKGROUND apply OPACITY.
+Return the new rgb color string."
+ (let* ((str "#")
+ ;; Why opacity squared??
+ (a (/ (float (* opacity opacity)) 10000))
+ (b (- 1 a)))
+ (dotimes (i 3 str)
+ (setq str (concat str (format "%X"
+ (round (+ (* a (djvu-color-string-to-hex color i))
+ (* b (djvu-color-string-to-hex background i))))))))))
+
+;;; Djvu modes
+
+(defvar djvu-read-mode-map
+ (let ((km (make-sparse-keymap)))
+ (define-key km "i" 'djvu-image-mode)
+ (define-key km "v" 'djvu-view)
+ (define-key km "\C-c\C-v" 'djvu-view)
+ (define-key km "n" 'djvu-next-page)
+ (define-key km "p" 'djvu-prev-page)
+ (define-key km "g" 'djvu-goto-page)
+ (define-key km "k" 'djvu-kill-doc)
+ (define-key km "\C-c\C-c" 'djvu-process)
+ (define-key km "\C-x\C-s" 'djvu-save)
+
+ (define-key km "h" 'djvu-highlight)
+ (define-key km "u" 'djvu-url)
+ (define-key km "a" 'djvu-switch-annot)
+ (define-key km "A" 'djvu-display-annot-all)
+
+ (define-key km "c" 'djvu-comment)
+ (define-key km "C" 'djvu-comment-pushpin)
+ (define-key km "b" 'djvu-bookmark)
+ (define-key km "m" 'djvu-himark)
+ (define-key km "o" 'djvu-switch-outline)
+
+ (define-key km "s" 'djvu-split-word)
+ (define-key km "w" 'djvu-merge-words)
+ (define-key km "l" 'djvu-merge-lines)
+
+ (define-key km "t" 'djvu-switch-text)
+ (define-key km "T" 'djvu-display-text-all)
+ km)
+ "Keymap for Djvu Read Mode.
+This is a child of `special-mode-map'.")
+
+(easy-menu-define
+ djvu-read-menu djvu-read-mode-map "Djvu Menu"
+ '("Djvu"
+ ["View File" djvu-view t]
+ ["Image File" djvu-image-mode t]
+ ["Go to Page" djvu-goto-page t]
+ ["Process Doc" djvu-process t]
+ ["Save Doc" djvu-save t]
+ "---"
+ ["Split Word" djvu-split-word t]
+ ["Merge Words" djvu-merge-words t]
+ ["Merge Lines" djvu-merge-lines t]
+ ["Switch to Text" djvu-switch-text t]
+ "---"
+ ["Highlight Region" djvu-highlight t]
+ ["URL over Region" djvu-url t]
+ ["Himark Region" djvu-himark t]
+ ["Add Comment" djvu-comment t]
+ ["Add Comment w/pushpin" djvu-comment-pushpin t]
+ ["Switch to Annotations" djvu-switch-annot t]
+ "---"
+ ["Show all Text" djvu-display-text-all t]
+ ["Show all Annotations" djvu-display-annot-all t]
+ ["Resolve all URLs" djvu-resolve-all-urls t]
+ ["Process all Annotations" djvu-process-all t]
+ ["Remove Annot / Outline" djvu-make-clean t]
+ "---"
+ ["Add Bookmark" djvu-bookmark t]
+ ["Switch to Outline" djvu-switch-outline t]
+ "---"
+ ["Quit Djvu" quit-window t]
+ ["Kill Djvu buffers" djvu-kill-doc t]))
+
+(define-derived-mode djvu-read-mode special-mode "Djview"
+ "Mode for reading Djvu files."
+ (setq mode-line-buffer-identification
+ (list 24 (buffer-name) " "
+ '(:eval (format "p%d" (djvu-doc-page))))))
+
+(defvar djvu-edit-mode-map
+ (let ((km (make-sparse-keymap)))
+ (define-key km "\C-c\C-r" 'djvu-switch-read)
+ (define-key km "\C-c\C-g" 'djvu-goto-page)
+ (define-key km "\C-c\C-s" 'djvu-split-word-internal)
+ (define-key km "\C-c\C-m" 'djvu-merge-words-internal)
+ (define-key km "\C-c\M-m" 'djvu-merge-lines-internal)
+ (define-key km "\C-c\C-c" 'djvu-process)
+ (define-key km "\C-x\C-s" 'djvu-save)
+ (define-key km "\C-c\C-v" 'djvu-view)
+ (define-key km "\C-c\C-k" 'djvu-kill-doc)
+ km)
+ "Keymap for Djvu Annot Mode.
+This is a child of `text-mode-map'.")
+
+(easy-menu-define
+ djvu-annot-menu djvu-edit-mode-map "Djvu Menu"
+ '("Djvu"
+ ["Go to Page" djvu-goto-page t]
+ ["Switch to Read" djvu-switch-read t]
+ ["Process Doc" djvu-process t]
+ ["Save Doc" djvu-save t]
+ "---"
+ ["Switch to Text" djvu-switch-text t]
+ ["Split Word" djvu-split-word-internal t]
+ ["Merge Words" djvu-merge-words-internal t]
+ ["Merge Lines" djvu-merge-lines-internal t]
+ "---"
+ ["Switch to Annot" djvu-switch-annot t]
+ "---"
+ ["Quit Djvu" quit-window t]
+ ["Kill Djvu buffers" djvu-kill-doc t]))
+
+(define-derived-mode djvu-edit-mode emacs-lisp-mode "Djvu Edit"
+ "Mode for editing (parts of) Djvu files."
+ (setq mode-line-buffer-identification
+ (list 24 (buffer-name) " "
+ '(:eval (format "p%d" (djvu-doc-page))))))
+
+;;; General Setup
+
+;;;###autoload
+(defun djvu-find-file (file &optional page view)
+ "Read and edit Djvu FILE on PAGE.
+If VIEW is non-nil start external viewer."
+ (interactive
+ (list (read-file-name "Find Djvu file: " nil nil nil nil
+ (lambda (f)
+ (or (equal "djvu" (file-name-extension f))
+ (file-directory-p f))))
+ (prefix-numeric-value current-prefix-arg)))
+ (unless page (setq page 1))
+ (setq file (expand-file-name file))
+ (unless (file-regular-p file)
+ (error "Cannot open Djvu file `%s'." file))
+ ;; Initialize `djvu-doc' for FILE.
+ (let* ((doc (make-vector djvu-doc-length nil))
+ (djvu-doc doc)
+ (basename (file-name-sans-extension
+ (file-name-nondirectory file)))
+ (read-buf (concat basename (nth 0 djvu-buffer-name-extensions)))
+ (text-buf (concat basename (nth 1 djvu-buffer-name-extensions)))
+ (annot-buf (concat basename (nth 2 djvu-buffer-name-extensions)))
+ (outline-buf (concat basename (nth 3 djvu-buffer-name-extensions)))
+ (buffers (list text-buf read-buf annot-buf outline-buf)))
+ ;; Do nothing if we are already visiting FILE such that all required
+ ;; buffers are properly defined. If some buffers were killed
+ ;; do not attempt to recycle the remaining buffers.
+ (unless (eval (cons 'and (mapcar 'get-buffer buffers)))
+ (dolist (buf buffers)
+ (if (get-buffer buf) (kill-buffer buf)))
+ (djvu-doc-set-file file)
+ (djvu-doc-set-basename basename)
+ (djvu-doc-set-text-buf (get-buffer-create text-buf))
+ (djvu-doc-set-read-buf (get-buffer-create read-buf))
+ (djvu-doc-set-annot-buf (get-buffer-create annot-buf))
+ (djvu-doc-set-outline-buf (get-buffer-create outline-buf))
+ ;; Initialize all buffers.
+ (dolist (buf (list (djvu-doc-text-buf) (djvu-doc-annot-buf)
+ (djvu-doc-outline-buf)))
+ (with-current-buffer buf
+ (djvu-edit-mode)
+ (setq djvu-doc doc)
+ (cd (file-name-directory (djvu-doc-file)))
+ (add-hook 'post-command-hook 'djvu-modified nil t)))
+ (with-current-buffer (djvu-doc-read-buf)
+ (djvu-read-mode)
+ (setq djvu-doc doc)
+ (cd (file-name-directory (djvu-doc-file)))
+ (add-hook 'post-command-hook 'djvu-modified nil t))
+ (djvu-init-page doc page))
+ (if view (djvu-view doc))
+ (switch-to-buffer read-buf)))
+
+(defun djvu-init-page (&optional doc page)
+ "For Djvu DOC initialize PAGE."
+ (if (djvu-doc-pagemax doc) (djvu-save doc t))
+ (djvu-doc-set-pos nil doc)
+ (if page (djvu-doc-set-page page doc))
+ (let* ((doc (or doc djvu-doc))
+ (new (not (djvu-doc-pagemax doc)))
+ object alist)
+ (with-temp-buffer
+ (djvu-djvused doc t "-e"
+ (format "%sselect %d; size; print-txt; print-ant;"
+ (if new "n; ls; print-outline; " "")
+ (djvu-doc-page doc)))
+ (goto-char (point-min))
+ (when new
+ ;; page max
+ (djvu-doc-set-pagemax (read (current-buffer)) doc)
+ ;; page id
+ (let (page-id)
+ (while (progn
+ (skip-chars-forward " \t\n")
+ (looking-at "\\(?:\\([0-9]+\\)[ \t]+\\)?\\([PIAT]\\)[
\t]+\\([0-9]+\\)[ \t]+\\([^ \t\n]+\\)$"))
+ (if (match-string 1)
+ ;; page-id is an alist with elements (PAGE-NUM . FILE-ID)
+ (push (cons (match-string 1) (match-string 4)) page-id))
+ (goto-char (match-end 0)))
+ (unless (eq (djvu-doc-pagemax doc) (length page-id))
+ (error "Page id list broken"))
+ (djvu-doc-set-page-id (nreverse page-id) doc))
+ ;; bookmarks
+ (skip-chars-forward " \t\n")
+ (when (looking-at "(bookmarks")
+ (setq object (read (current-buffer)))
+ (djvu-decode-outline (cdr object))
+ (with-current-buffer (djvu-doc-outline-buf doc)
+ (insert "(bookmarks")
+ (let (print-escape-newlines)
+ (djvu-insert-outline (cdr object) " "))
+ (insert ")\n")
+ (goto-char (point-min))
+ (set-buffer-modified-p nil)
+ (setq buffer-undo-list nil))))
+
+ ;; page size
+ (skip-chars-forward " \t\n")
+ (if (looking-at "width=\\([[:digit:]]+\\)[
\t]+height=\\([[:digit:]]+\\)$")
+ (djvu-doc-set-pagesize (cons (string-to-number (match-string 1))
+ (string-to-number (match-string 2)))
doc)
+ (error "No pagesize"))
+
+ ;; raw text
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t\n")
+ (setq object (if (looking-at
"(\\(page\\|column\\|region\\|para\\|line\\|word\\|char\\)")
+ (read (current-buffer))))
+ (djvu-decode-text object)
+ (with-current-buffer (djvu-doc-text-buf doc)
+ (erase-buffer)
+ (djvu-insert-text object "")
+ (insert "\n")
+ (goto-char (point-min))
+ (set-buffer-modified-p nil)
+ (setq buffer-undo-list nil))
+
+ ;; Set up read buffer
+ (djvu-init-read doc object)
+
+ ;; Set up annotations buffer:
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (djvu-hide-hash)))
+ (setq object nil)
+ (while (progn (skip-chars-forward " \t\n") (not (eobp)))
+ (if (looking-at
"(\\(background\\|zoom\\|mode\\|align\\|maparea\\|metadata\\)\\>")
+ (push (read (current-buffer)) object)
+ (error "Unknown annotation `%s'" (buffer-substring-no-properties
+ (point) (line-end-position)))))
+ ;; To simplify the editing of annotations, identify mapareas (rect)
+ ;; sharing the same text string.
+ (dolist (elt object)
+ (if (not (eq 'maparea (car elt)))
+ (push elt alist)
+ (setcar (cdr elt) (decode-coding-string (nth 1 elt) 'utf-8))
+ (setcar (nthcdr 2 elt) (decode-coding-string (nth 2 elt) 'utf-8))
+ (cond ((eq 'rect (car (nth 3 elt))) ; rect
+ (let ((rect (djvu-rect (nth 3 elt)))
+ e)
+ (setcdr (nthcdr 2 elt) (nthcdr 4 elt)) ; remove rect
destructively
+ ;; The new elements of alist are cons cells, where the car
is the
+ ;; maparea without rect, and the cdr is the list of rect
areas.
+ ;; Even if we have just an empty string, we still want to
massage
+ ;; the rect box.
+ (if (or (string= "" (nth 2 elt))
+ (not (setq e (assoc elt alist))))
+ (push (cons elt (list rect)) alist)
+ (setcdr e (cons rect (cdr e))))))
+ ((eq 'text (car (nth 3 elt))) ; text
+ (setcar (nthcdr 3 elt) (djvu-rect (nth 3 elt)))
+ (push elt alist))
+ (t (push elt alist)))))
+ ;; Pretty print annotations.
+ (with-current-buffer (djvu-doc-annot-buf doc)
+ (let ((standard-output (current-buffer))
+ print-escape-newlines)
+ (erase-buffer)
+ (dolist (elt alist)
+ (cond ((consp (car elt)) ;; maparea with list of rects
+ (let ((c (car elt)))
+ (insert (format "(maparea %S\n %S\n ("
+ (djvu-resolve-url (nth 1 c) doc) (nth 2
c))
+ (mapconcat 'prin1-to-string (cdr elt) "\n ")
")\n " ; rect
+ (mapconcat 'prin1-to-string (nthcdr 3 c) " ") ;
rest
+ ")")))
+ ((not (eq 'maparea (car elt)))
+ (prin1 elt))
+ ((eq 'text (car (nth 3 elt))) ; text
+ (insert (format "(maparea %S\n %S\n " (nth 1 elt) (nth 2
elt))
+ (mapconcat 'prin1-to-string (nthcdr 3 elt) " ") ;
rest
+ ")"))
+ (t (error "Djvu maparea %s undefined" (car (nth 3 elt)))))
+ (insert "\n\n")))
+ (djvu-hide-hash t)
+ (goto-char (point-max))
+ (set-buffer-modified-p nil)
+ (setq buffer-undo-list nil)))))
+
+(defun djvu-resolve-url (url &optional doc)
+ "Resolve internal URLs. See variable `djvu-resolve-url'."
+ (cond ((eq 'long djvu-resolve-url)
+ ;; Replace page number by file id
+ (cond ((string-match "\\`#[0-9]+\\'" url)
+ (let ((page-id (assoc (substring-no-properties url 1)
+ (djvu-doc-page-id doc))))
+ (if page-id
+ (concat "#" (cdr page-id))
+ (error "Page id broken: %s" url))))
+ ((string-match "\\`#" url)
+ (if (rassoc (substring-no-properties url 1)
+ (djvu-doc-page-id doc))
+ url
+ (error "Page id broken: %s" url)))
+ (t url))) ; some other URL
+ ((eq 'short djvu-resolve-url)
+ ;; Replace file id by page number
+ (cond ((string-match "\\`#[0-9]+\\'" url)
+ url)
+ ((string-match "\\`#" url)
+ (let ((page-id (rassoc (substring-no-properties url 1)
+ (djvu-doc-page-id doc))))
+ (if page-id
+ (concat "#" (car page-id))
+ (error "Page id broken: %s" url))))
+ (t url))) ; some other URL
+ (t url))) ; do nothing
+
+(defun djvu-resolve-all-urls (dir)
+ "Resolve all internal URLs in a Djvu file."
+ (interactive
+ (list (intern (completing-read "Direction: " '((long) (short)) nil t))))
+ (if (djvu-modified) (error "Djvu file should be saved"))
+ (let ((page-id (djvu-doc-page-id djvu-doc))
+ (djvu-all-buffer (generate-new-buffer " *djvu*"))
+ (djvu-resolve-url dir))
+ (djvu-display-annot-all)
+ (with-current-buffer djvu-all-buffer
+ (goto-char (point-min))
+ (cond ((eq dir 'long)
+ (while (re-search-forward "^(maparea[ \t]+\"#\\([0-9]+\\)\"" nil
t)
+ (replace-match (cdr (assoc (match-string 1) page-id))
+ nil nil nil 1)))
+ ((eq dir 'short)
+ (while (re-search-forward "^(maparea[ \t]+\"#\\([^\"]+\\)\"" nil
t)
+ (replace-match (car (rassoc (match-string 1) page-id))
+ nil nil nil 1)))))
+ (djvu-process-all)
+ (kill-buffer djvu-all-buffer)
+ (with-current-buffer (djvu-doc-outline-buf)
+ (set-buffer-modified-p t))
+ (djvu-save)))
+
+(defun djvu-rect (rect &optional back)
+ "Convert (rect xmin ymin width height) to (rect xmin ymin xmax ymax).
+If BACK is non-nil do inverse transformation."
+ (let* ((f (if back '- '+))
+ (lst (list (nth 0 rect) (nth 1 rect) (nth 2 rect)
+ (funcall f (nth 3 rect) (nth 1 rect))
+ (funcall f (nth 4 rect) (nth 2 rect)))))
+ ;; Only for back transforms we might get an error...
+ (if (or (> 0 (nth 3 lst)) (> 0 (nth 4 lst)))
+ (error "Annotation rect dimensions %s, %s" (nth 3 lst) (nth 4 lst)))
+ lst))
+
+(defun djvu-view (&optional doc)
+ "Start Djview for DOC."
+ (interactive (list djvu-doc))
+ (if (not (window-system))
+ (message "No window system available")
+ (djvu-kill-view)
+ (let* ((djvu-doc doc)
+ (pos (or (djvu-doc-pos) (djvu-read-pos)))
+ (px (/ (float (car pos))
+ (float (car (djvu-doc-pagesize)))))
+ (py (- 1 (/ (float (cdr pos))
+ (float (cdr (djvu-doc-pagesize))))))
+ process-connection-type) ; Use a pipe.
+ (if (or (< px 0) (< 1 px) (< py 0) (< 1 py))
+ (error "px=%s, py=%s out of range" px py))
+ (djvu-doc-set-pos nil)
+ (djvu-doc-set-view-proc
+ (start-process "djview" nil "djview"
+ (format "-page=%d" (djvu-doc-page))
+ (format "-showposition=%06f,%06f" px py)
+ (djvu-doc-file))))))
+
+;;; Djvu Text mode
+
+(defun djvu-split-word (pos)
+ "Split word at position POS.
+This command operates on the read buffer."
+ (interactive "d")
+ (let ((beg (djvu-property-beg pos 'word))
+ (rpos (djvu-read-pos pos)))
+ (with-current-buffer (djvu-doc-text-buf)
+ (djvu-split-word-internal (djvu-locate-pos 'word rpos)
+ (- pos beg))))
+ ;; Things get rather confusing without updating the read buffer.
+ ;; So we better save everything.
+ (djvu-save))
+
+(defun djvu-split-word-internal (wpos split)
+ "Split word at position WPOS at character position SPLIT.
+This command operates on the text buffer."
+ (interactive
+ (let* ((pnt (point))
+ (pps (parse-partial-sexp (line-beginning-position) pnt)))
+ (unless (nth 3 pps) (error "Not inside string"))
+ (list pnt (1- (- pnt (nth 8 pps))))))
+ (goto-char wpos)
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (setq wpos (point))
+ (let ((indent (buffer-substring-no-properties
+ (line-beginning-position) wpos))
+ word)
+ (condition-case nil
+ (progn
+ (setq word (read (current-buffer)))
+ (unless (eq 'word (car word)) (error "invalid")))
+ (error (error "Syntax error in raw text")))
+ (if (or (< split 1) (<= (length (nth 5 word)) split))
+ (error "nothing to split"))
+ (delete-region wpos (point))
+ ;; To split the bounding box horizontally, we take the fraction
+ ;; of the number of characters in each fragment. This scheme
+ ;; is only approximate, but it is better than nothing.
+ (let ((frac (round (* (/ (float split) (length (nth 5 word)))
+ (- (nth 3 word) (nth 1 word))))))
+ (djvu-insert-text (list 'word (nth 1 word) (nth 2 word)
+ (+ (nth 1 word) frac) (nth 4 word)
+ (substring (nth 5 word) 0 split)) "")
+ (insert "\n" indent)
+ (djvu-insert-text (list 'word (+ (nth 1 word) frac 1) (nth 2 word)
+ (nth 3 word) (nth 4 word)
+ (substring (nth 5 word) split)) ""))))
+
+(defun djvu-merge-words (beg end)
+ "Merge words between positions BEG and END.
+This command operates on the read buffer."
+ (interactive "r")
+ (let ((bpos (djvu-read-pos beg))
+ (epos (djvu-read-pos (1- end))))
+ (with-current-buffer (djvu-doc-text-buf)
+ (djvu-merge-words-internal (djvu-locate-pos 'word bpos)
+ (djvu-locate-pos 'word epos))))
+ ;; Things get rather confusing without updating the read buffer.
+ ;; So we better save everything.
+ (djvu-save))
+
+(defun djvu-merge-words-internal (beg end)
+ "Merge words between positions BEG and END.
+This command operates on the text buffer."
+ (interactive "r")
+ (let (words)
+ (goto-char end)
+ (if (bolp) (setq end (1- end)))
+ (goto-char beg)
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (setq beg (point))
+ (condition-case nil
+ (while (< (point) end)
+ (push (read (current-buffer)) words)
+ (unless (eq 'word (caar words)) (error "invalid")))
+ (error (error "Syntax error in raw text")))
+ (delete-region beg (point))
+ (let ((object (apply 'list 'word 0 0 0 0 (nreverse words))))
+ (djvu-process-text-bbox object 0 (make-vector 3 nil))
+ (setcdr (nthcdr 4 object) (list (mapconcat (lambda (w) (nth 5 w))
+ (nthcdr 5 object) "")))
+ (djvu-insert-text object "")))
+ (undo-boundary))
+
+(defun djvu-merge-lines (beg end)
+ "Merge lines between positions BEG and END.
+This command operates on the read buffer."
+ (interactive "r")
+ (let ((bpos (djvu-read-pos beg))
+ (epos (djvu-read-pos (1- end))))
+ (with-current-buffer (djvu-doc-text-buf)
+ (djvu-merge-lines-internal (djvu-locate-pos 'word bpos)
+ (djvu-locate-pos 'word epos))))
+ ;; Things get rather confusing without updating the read buffer.
+ ;; So we better save everything.
+ (djvu-save))
+
+(defun djvu-merge-lines-internal (beg end)
+ "Merge lines between positions BEG and END.
+This command operates on the text buffer."
+ (interactive "r")
+ ;; Calculate proper value of END
+ (goto-char end)
+ (beginning-of-line)
+ (unless (looking-at "[ \t]*(line ")
+ (re-search-backward "^[ \t]*(line ")
+ (forward-sexp)
+ (setq end (point)))
+ ;; Calculate proper value of BEG
+ (goto-char beg)
+ (beginning-of-line)
+ (unless (looking-at "[ \t]*(line ")
+ (re-search-backward "^[ \t]*(line "))
+ (skip-chars-forward " \t")
+ (setq beg (point))
+ (unless (< beg end) (error "Nothing to merge"))
+ ;; Parsing fails if the words belong to different paragraphs,
+ ;; regions or columns. We would have to determine the lowest common
+ ;; object level of these words. Then we could possibly merge
+ ;; everything (!) within this level
+ (if (re-search-forward "^[ \t]*\\(?:para\\|region\\|column\\)" end t)
+ (error "Cannot merge paragraphs, regions or columns"))
+ (let (words)
+ ;; Collect all words
+ (condition-case nil
+ (while (<= (point) end)
+ (cond ((looking-at "[ \t]*(word ")
+ (push (read (current-buffer)) words))
+ ((not (looking-at "[ \t]*(line "))
+ (error "invalid")))
+ (forward-line))
+ (error (error "Syntax error in raw text")))
+ ;; Remove old words
+ (goto-char beg)
+ (while (let ((start (point)))
+ (forward-sexp)
+ (or (<= (point) end)
+ (progn (goto-char start) nil))))
+ (delete-region beg (point))
+ ;; Re-insert words
+ (let ((indent (buffer-substring-no-properties
+ (line-beginning-position) (point)))
+ (object (apply 'list 'line 0 0 0 0 (nreverse words))))
+ (djvu-process-text-bbox object 0 (make-vector 3 nil))
+ (delete-region (line-beginning-position) (point))
+ (djvu-insert-text object indent)))
+ (undo-boundary))
+
+(defun djvu-decode-text (object &optional encode)
+ (if (stringp (nth 5 object))
+ (setcar (nthcdr 5 object)
+ (if encode
+ (encode-coding-string (nth 5 object) 'utf-8)
+ (decode-coding-string (nth 5 object) 'utf-8)))
+ (dolist (elt (nthcdr 5 object))
+ (djvu-decode-text elt encode))))
+
+(defun djvu-insert-text (object indent)
+ ;; This function is called recursively.
+ (insert indent "("
+ (mapconcat 'prin1-to-string
+ (list (nth 0 object) (nth 1 object) (nth 2 object)
+ (nth 3 object) (nth 4 object)) " "))
+ (let ((tail (nthcdr 5 object))
+ (indent (concat indent " ")))
+ (if (stringp (car tail))
+ ;; use `prin1-to-string' as we use this function both for
+ ;; utf-8 and encoded stuff.
+ (insert " " (prin1-to-string (car tail)) ")")
+ (dolist (elt tail)
+ (insert "\n")
+ (djvu-insert-text elt indent))
+ (insert ")"))))
+
+(defun djvu-process-text (script &optional doc)
+ (let ((doc (or doc djvu-doc))
+ object)
+ (with-current-buffer (djvu-doc-text-buf doc)
+ (save-excursion
+ (goto-char (point-min))
+ (condition-case nil
+ (setq object (read (current-buffer)))
+ (error (error "Syntax error in raw text")))
+ (skip-chars-forward " \t\n")
+ ;; We should have swallowed all raw text.
+ (unless (eobp)
+ (error "Syntax error in raw text (end of buffer)"))))
+ (djvu-process-text-bbox object 0 (make-vector 7 nil))
+ ;; Update read buffer
+ (djvu-init-read doc object)
+ ;; FIXME: Should we also update the text buffer?
+ ;; A transparent solution would update only the part of the buffer
+ ;; that we actually changed so that `undo' works as expected.
+ (djvu-decode-text object t)
+ (with-temp-buffer
+ (insert (format "select %d\nremove-txt\nset-txt\n" (djvu-doc-page doc)))
+ (djvu-insert-text object "")
+ (insert "\n.\n")
+ (write-region nil nil script t 0))))
+
+(defun djvu-process-text-bbox (object depth coords)
+ "Evaluate bounding box for text OBJECT recursively."
+ (if (stringp (nth 5 object))
+ (aset coords depth (vector (nth 1 object) (nth 2 object)
+ (nth 3 object) (nth 4 object)))
+ (let ((depth1 (1+ depth))
+ coord)
+ (aset coords depth nil)
+ (dolist (elt (nthcdr 5 object))
+ (djvu-process-text-bbox elt depth1 coords)
+ (if (setq coord (aref coords depth))
+ (let ((coord1 (aref coords depth1)))
+ (aset coord 0 (min (aref coord 0) (aref coord1 0)))
+ (aset coord 1 (min (aref coord 1) (aref coord1 1)))
+ (aset coord 2 (max (aref coord 2) (aref coord1 2)))
+ (aset coord 3 (max (aref coord 3) (aref coord1 3))))
+ (aset coords depth (copy-sequence (aref coords depth1)))))
+ (if (setq coord (aref coords depth))
+ (setcdr object (apply 'list (aref coord 0) (aref coord 1)
+ (aref coord 2) (aref coord 3)
+ (nthcdr 5 object)))
+ (error "No coords??")))))
+
+(defun djvu-display-text-all ()
+ "Display text for all pages."
+ (interactive)
+ (let ((doc djvu-doc)
+ (buf (get-buffer-create djvu-all-buffer)))
+ ;; Put this in a separate buffer!
+ (with-current-buffer buf
+ (let (buffer-read-only)
+ (emacs-lisp-mode)
+ (erase-buffer)
+ (djvu-djvused doc t "-e" "output-txt")
+ (goto-char (point-min)))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t))
+ (switch-to-buffer buf)))
+
+(defun djvu-process-all ()
+ "Process all pages. Use at your own risk. You get what you want."
+ (interactive)
+ (let ((buf (get-buffer djvu-all-buffer))
+ script)
+ (unless buf (error "No buffer `%s'" buf))
+ (unless djvu-doc (error "No Djvu doc"))
+ (unwind-protect
+ (progn
+ (setq script (make-temp-file "djvu-el-"))
+ (with-temp-file script (insert-buffer-substring buf))
+ (djvu-djvused djvu-doc nil "-f" script "-s"))
+ (djvu-delete-file script))))
+
+;;; Djvu Read mode
+
+(defun djvu-init-read (doc object)
+ (with-current-buffer (djvu-doc-read-buf doc)
+ (let (buffer-read-only)
+ (erase-buffer)
+ (djvu-insert-read object))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (goto-char (point-min))
+ (djvu-image)))
+
+(defun djvu-insert-read (object)
+ "Display text OBJECT."
+ ;; This function is called recursively.
+ (let ((opoint (point))
+ (tail (nthcdr 5 object)))
+ (if (stringp (car tail))
+ (insert (decode-coding-string (car tail) 'utf-8))
+ (let* ((obj (caar tail))
+ (sep (cond ((eq 'line obj) "\n")
+ ((eq 'word obj) "\s")
+ ((eq 'char obj) nil)
+ (t "\n\n")))
+ elt)
+ (while (setq elt (pop tail))
+ (djvu-insert-read elt)
+ (if (and sep tail (not (looking-back sep)))
+ (insert sep)))))
+ (put-text-property opoint (point) (car object)
+ (vector (nth 1 object) (nth 2 object)
+ (nth 3 object) (nth 4 object)))))
+
+(defun djvu-read-pos (&optional point)
+ "Return Djvu position (x . y) of POINT in Djvu Read buffer."
+ (with-current-buffer (djvu-doc-read-buf)
+ ;; An empty djvu page gives us something like (page 0 0 0 0 "")
+ (if (= (point-min) (point-max))
+ ;; Take the center of an empty page
+ (cons (/ (car (djvu-doc-pagesize)) 2)
+ (/ (cdr (djvu-doc-pagesize)) 2))
+ (unless point (setq point (point)))
+ (djvu-mean-pos ; Return mean coordinates
+ (or (get-text-property point 'word)
+ (get-text-property (1- point) 'word)
+ (get-text-property
+ ;; Search backward because more often point is at the end
+ ;; of region we operated on
+ (1- (previous-single-property-change point 'word)) 'word))))))
+
+(defun djvu-mean-pos (reg)
+ "For region REG return mean coordinates (x . y)."
+ ;; This works both for REG being vectors and lists.
+ (cons (/ (+ (elt reg 0) (elt reg 2)) 2)
+ (/ (+ (elt reg 1) (elt reg 3)) 2)))
+
+(defun djvu-locate-pos (object pos)
+ "Locate OBJECT at position POS in the text or annotation buffer.
+If found, return corresponding position. Otherwise, return nil."
+ (goto-char (point-min))
+ (when pos
+ (let ((re (concat "\\<" (symbol-name object) "\\> +"
+ (mapconcat 'identity
+ (make-list 4 "\\([[:digit:]]+\\)") " +")
+ "\\( +\"\\)?"))
+ done)
+ (while (and (not done)
+ (re-search-forward re nil t))
+ (let ((x1 (string-to-number (match-string 1)))
+ (x2 (string-to-number (match-string 3)))
+ (y1 (string-to-number (match-string 2)))
+ (y2 (string-to-number (match-string 4))))
+ (setq done (and (<= x1 (car pos))
+ (<= (car pos) x2)
+ (<= y1 (cdr pos))
+ (<= (cdr pos) y2)))))
+ (if done (point)
+ (goto-char (point-min)) nil))))
+
+(defsubst djvu-dist (width height)
+ (+ (* width width) (* height height)))
+
+(defun djvu-locate-read-pos (pos)
+ "Locate POS in Djvu Read buffer. Return corresponding position."
+ (with-current-buffer (djvu-doc-read-buf)
+ (if (not pos)
+ (goto-char (point-min))
+ (let ((hpos (car pos)) (vpos (cdr pos))
+ (good-dist (djvu-dist (car (djvu-doc-pagesize))
+ (cdr (djvu-doc-pagesize))))
+ (pnt (point-min)) (good-pnt (point-min))
+ word dist)
+ (while (progn
+ (when (setq word (get-text-property pnt 'word))
+ (setq dist (djvu-dist (- (/ (+ (aref word 0) (aref word 2))
2) hpos)
+ (- (/ (+ (aref word 1) (aref word 3))
2) vpos)))
+ (if (< dist good-dist)
+ (setq good-pnt pnt good-dist dist)))
+ (setq pnt (next-single-property-change pnt 'word))))
+ (goto-char good-pnt)))))
+
+;;; Djvu Annotation mode
+
+(defun djvu-comment-interactive (&optional border backclr textclr pushpin)
+ "Interactive spec for `djvu-comment' and friends."
+ (let ((pos (djvu-read-pos))
+ (pagesize (djvu-doc-pagesize))
+ (color (djvu-interactive-color djvu-color-highlight)))
+ (list "" (read-string (format "(%s) Text: " color))
+ (list (car pos) (cdr pos)
+ (+ (car pos) (/ (car pagesize) 2))
+ (+ (cdr pos) (/ (cdr pagesize) 30)))
+ border
+ (or backclr
+ (djvu-color-background color djvu-color-background
+ djvu-opacity))
+ textclr pushpin)))
+
+(defsubst djvu-insert-color (key color)
+ (if color
+ (format " (%s %s)" key
+ (cond ((string-match "\\`#" color) color)
+ ((cdr (assoc color djvu-color-alist)))
+ (t (error "Color `%s' undefined" color))))
+ ""))
+
+(defun djvu-comment (url text rect &optional border backclr textclr pushpin)
+ "Using URL and TEXT, highlight RECT.
+This defines a rect area for djvused."
+ (interactive (djvu-comment-interactive))
+ (with-current-buffer (djvu-doc-annot-buf)
+ (goto-char (point-max))
+ (let (print-escape-newlines)
+ (insert (format "(maparea %S\n %S\n " url (djvu-fill text))
+ (apply 'format "(text %d %d %d %d)" rect)
+ (if border (format " (%s)" border) "")
+ (djvu-insert-color "backclr" backclr)
+ (djvu-insert-color "textclr" textclr)
+ (if pushpin " (pushpin)" "")
+ ")\n\n"))
+ (undo-boundary)))
+
+(defun djvu-comment-pushpin (url text rect
+ &optional border backclr textclr pushpin)
+ (interactive (djvu-comment-interactive nil nil nil t))
+ (djvu-comment url text rect border backclr textclr pushpin))
+
+(defun djvu-himark (beg end url text &optional color opacity border)
+ "Himark region between BEG and END.
+This highlights the region between BEG and END and creates a bookmark entry."
+ (interactive
+ (let ((region (djvu-interactive-region)))
+ (list (car region) (cdr region) "" ""
+ djvu-color-himark djvu-opacity 'none)))
+ (djvu-highlight beg end url text color opacity border)
+ (djvu-bookmark (buffer-substring-no-properties beg end) (djvu-doc-page)))
+
+(defun djvu-url (beg end url text &optional color opacity border)
+ (interactive
+ (let* ((region (djvu-interactive-region))
+ (color (djvu-interactive-color djvu-color-url))
+ (url (djvu-interactive-url color)))
+ (list (car region) (cdr region) url "" color djvu-opacity 'xor)))
+ (djvu-highlight beg end url text color opacity border))
+
+(defun djvu-highlight (beg end url text &optional color opacity border)
+ "Highlight region between BEG and END, add annotation TEXT."
+ (interactive
+ (let ((region (djvu-interactive-region))
+ (color (djvu-interactive-color djvu-color-highlight)))
+ (list (car region) (cdr region) ""
+ (read-string (format "(%s) Annotation: " color))
+ color djvu-opacity 'none)))
+
+ (unless (get-text-property beg 'word)
+ (error "Start position `%s' not a word" beg))
+ (unless (get-text-property (1- end) 'word)
+ (error "End position `%s' not a word" end))
+ (let ((words (djvu-region-count beg end 'word))
+ (lines (djvu-region-count beg end 'line))
+ (paras (djvu-region-count beg end 'para))
+ (regions (djvu-region-count beg end 'region))
+ (columns (djvu-region-count beg end 'column))
+ coords)
+ (unless (and (>= 1 paras) (>= 1 regions) (>= 1 columns))
+ (error "Region spans multiple paragraphs"))
+
+ (if (eq 1 lines)
+ (setq coords (list (djvu-scan-coords beg end 'word)))
+
+ (if (eq 2 lines)
+ (let ((c1 (djvu-scan-coords beg (djvu-property-end (1+ beg) 'line)
'word))
+ (c2 (djvu-scan-coords (djvu-property-beg (1- end) 'line) end
'word)))
+ ;; If BEG is beginning of first line, both lines share same left
margin.
+ (if (and (= beg (djvu-property-beg beg 'line))
+ (djvu-coords-justify t c1 c2))
+ (djvu-justify-coords 'min 0 c1 c2))
+ ;; If END is end of second line, both lines share same right
margin.
+ (if (and (= end (djvu-property-end end 'line))
+ (djvu-coords-justify nil c2 c1))
+ (djvu-justify-coords 'max 2 c1 c2))
+ (if (<= (aref c1 0) (aref c2 2))
+ ;; Lower bound of upper box and upper bound of lower box
coincide.
+ (let ((tmp (/ (+ (aref c1 1) (aref c2 3)) 2)))
+ (aset c1 1 tmp) (aset c2 3 tmp)))
+ (setq coords (list c1 c2)))
+ ;; 3 lines
+ (let* ((l1e (djvu-property-end (1+ beg) 'line))
+ (l2b (djvu-property-beg (1- end) 'line))
+ (c1 (djvu-scan-coords beg l1e 'word))
+ (ci (djvu-scan-coords (1+ l1e) (1- l2b) 'line))
+ (c2 (djvu-scan-coords l2b end 'word)))
+ ;; If BEG is beginning of first line, all lines share same left
margin.
+ (cond ((and (= beg (djvu-property-beg beg 'line))
+ (djvu-coords-justify t c1 ci c2))
+ (djvu-justify-coords 'min 0 c1 ci c2))
+ ((djvu-coords-justify t ci c2)
+ (djvu-justify-coords 'min 0 ci c2)))
+ ;; If END is end of last line, all lines share same right margin.
+ (cond ((and (= end (djvu-property-end end 'line))
+ (djvu-coords-justify nil c2 ci c1))
+ (djvu-justify-coords 'max 2 c1 ci c2))
+ ((djvu-coords-justify nil c1 ci)
+ (djvu-justify-coords 'max 2 c1 ci)))
+ (let ((tmp1 (/ (+ (aref c1 1) (aref ci 3)) 2))
+ (tmp2 (/ (+ (aref ci 1) (aref c2 3)) 2)))
+ ;; Lower bound of upper boxes and upper bound of lower boxes
coincide.
+ (aset c1 1 tmp1) (aset ci 3 tmp1)
+ (aset ci 1 tmp2) (aset c2 3 tmp2))
+ (setq coords (list c1 ci c2)))))
+
+ (djvu-highlight-region url text coords color opacity border)))
+
+(defun djvu-highlight-region (url text coords &optional color opacity border)
+ "Using URL and TEXT, highlight COORDS.
+This defines a hilite area for djvused."
+ ;; Record position where annotation was made.
+ (let ((posl (mapcar 'djvu-mean-pos coords))
+ (n (length coords)))
+ (djvu-doc-set-pos (cons (/ (apply '+ (mapcar 'car posl)) n)
+ (/ (apply '+ (mapcar 'cdr posl)) n))))
+ ;; Insert in Annotations buffer.
+ (with-current-buffer (djvu-doc-annot-buf)
+ (goto-char (point-max))
+ (let (print-escape-newlines)
+ (insert (format "(maparea %S\n %S\n (" url (djvu-fill text))
+ (mapconcat
+ (lambda (rect) (apply 'format "(rect %d %d %d %d)" (append rect
nil)))
+ coords "\n ") ")\n"
+ (djvu-insert-color "hilite" color)
+ (if opacity (format " (opacity %s)" opacity) "")
+ (if border (format " (%s)" border) "")
+ ")\n\n"))
+ (undo-boundary)))
+
+(defun djvu-fill (text)
+ "Fill string TEXT using `djvu-fill-column'."
+ (if djvu-fill-column
+ (with-temp-buffer
+ (insert text)
+ (let ((fill-column djvu-fill-column))
+ (fill-region (point-min) (point-max)))
+ (buffer-substring-no-properties
+ (point-min) (point-max)))
+ text))
+
+(defun djvu-property-beg (pnt prop)
+ ;; Assume that PNT has PROP. Otherwise we would not know whether
+ ;; to search for it before or after PNT.
+ (let ((p1 (get-text-property pnt prop)))
+ (unless p1 (error "Position %s does not have property %s" pnt prop))
+ (if (> pnt (point-min))
+ (let ((p0 (get-text-property (1- pnt) prop)))
+ (if (eq p0 p1)
+ (setq pnt (previous-single-property-change
+ pnt prop nil (point-min))))))
+ pnt))
+
+(defun djvu-property-end (pnt prop)
+ ;; Assume that (1- PNT) has PROP. Otherwise we would not know whether
+ ;; to search for it before or after PNT.
+ (let ((p1 (get-text-property (1- pnt) prop)))
+ (unless p1 (error "Position %s does not have property %s" pnt prop))
+ (if (< pnt (point-max))
+ (let ((p0 (get-text-property pnt prop)))
+ (if (eq p0 p1)
+ (setq pnt (next-single-property-change
+ (1- pnt) prop nil (point-max))))))
+ pnt))
+
+(defun djvu-coords-justify (left &rest ci)
+ "Return non-nil if rect coordinates CI shall be justified horizontally.
+If LEFT is nil analyze left boundaries of CI, otherwise the right boundaries."
+ (let ((xl (apply 'min (mapcar (lambda (c) (aref c 0)) ci)))
+ (xr (apply 'max (mapcar (lambda (c) (aref c 2)) ci))))
+ (> djvu-coords-justify
+ (/ (apply 'max (mapcar (lambda (cj)
+ (abs (float (if left (- (aref cj 0) xl)
+ (- xr (aref cj 2))))))
+ ci))
+ (float (- xr xl))))))
+
+(defun djvu-justify-coords (fun n &rest ci)
+ "Pass Nth elements of arrays CI to function FUN.
+Set these elements to return value of FUN.
+If FUN is `min' or `max' these elements are set to the respective minimum
+or maximum among the Nth elements of all arrays CI."
+ (let ((tmp (apply fun (mapcar (lambda (c) (aref c n)) ci))))
+ (dolist (c ci)
+ (aset c n tmp))))
+
+(defun djvu-scan-coords (beg end prop)
+ "Between BEG and END calculate total bounding box for PROP."
+ ;; Assume that BEG has PROP.
+ (let ((coords (copy-sequence (get-text-property beg prop)))
+ (pnt beg) val)
+ (while (and (/= pnt end)
+ (setq pnt (next-single-property-change pnt prop nil end)))
+ (when (setq val (get-text-property pnt prop))
+ (aset coords 0 (min (aref coords 0) (aref val 0)))
+ (aset coords 1 (min (aref coords 1) (aref val 1)))
+ (aset coords 2 (max (aref coords 2) (aref val 2)))
+ (aset coords 3 (max (aref coords 3) (aref val 3)))))
+ coords))
+
+(defun djvu-region-count (beg end prop)
+ "Count regions between BEG and END with distinct non-nil values of PROP."
+ (let ((count 0)
+ (pnt beg))
+ (while (and (/= pnt end)
+ (setq pnt (next-single-property-change pnt prop nil end)))
+ (if (get-text-property (1- pnt) prop)
+ (setq count (1+ count))))
+ count))
+
+(defun djvu-process-annot (script &optional doc)
+ (let ((doc djvu-doc) object)
+ (with-temp-buffer
+ (insert-buffer-substring (djvu-doc-annot-buf doc))
+ (djvu-hide-hash)
+ (goto-char (point-min))
+ (while (progn (skip-chars-forward " \t\n") (not (eobp)))
+ (if (looking-at
"(\\(background\\|zoom\\|mode\\|align\\|maparea\\|metadata\\)\\>")
+ (condition-case nil
+ (push (read (current-buffer)) object)
+ (error (error "Syntax error in annotations")))
+ (error "Unknown annotation `%s'" (buffer-substring-no-properties
+ (point) (line-end-position))))))
+ (setq object (nreverse object))
+ (dolist (elt object)
+ (when (eq 'maparea (car elt))
+ ;; URL
+ (setcar (cdr elt) (encode-coding-string (djvu-resolve-url (nth 1 elt))
'utf-8))
+ ;; Comment
+ (setcar (nthcdr 2 elt) (encode-coding-string (nth 2 elt) 'utf-8))))
+
+ (with-temp-buffer
+ (let ((standard-output (current-buffer))
+ (print-escape-newlines t)
+ str)
+ (insert (format "select %d\nremove-ant\nset-ant\n"
+ (djvu-doc-page doc)))
+ (dolist (elt object)
+ (cond ((not (eq 'maparea (car elt)))
+ (prin1 elt)
+ (insert "\n"))
+ ((consp (car (nth 3 elt))) ; rect
+ (dolist (e (nth 3 elt))
+ (insert (prin1-to-string
+ (apply 'list (car elt) (nth 1 elt) (nth 2 elt)
+ (djvu-rect e t) (nthcdr 4 elt))) "\n")))
+ ((eq 'text (car (nth 3 elt))) ; text
+ (insert (prin1-to-string
+ (apply 'list (car elt) (nth 1 elt) (nth 2 elt)
+ (djvu-rect (nth 3 elt) t)
+ (nthcdr 4 elt))) "\n"))
+ (t (error "Djvu maparea %s undefined" (car (nth 3 elt))))))
+ (insert ".\n")
+ (djvu-hide-hash t))
+ (write-region nil nil script t 0))))
+
+(defun djvu-display-annot-all (&optional display)
+ "Print annotations for all pages."
+ (interactive (list t))
+ (let ((doc djvu-doc)
+ (buf (get-buffer-create djvu-all-buffer)))
+ ;; Put this in a separate buffer!
+ (with-current-buffer buf
+ (let (buffer-read-only)
+ (emacs-lisp-mode)
+ (erase-buffer)
+ (djvu-djvused doc t "-e" "output-ant")
+ (goto-char (point-min))
+ (while (re-search-forward "^(maparea" nil t)
+ (forward-sexp) ; jump over URL
+ ;; replace newlines within text
+ (let ((limit (save-excursion (forward-sexp) (point))))
+ (while (search-forward "\\n" limit t)
+ (replace-match "\n"))))
+ (goto-char (point-min)))
+ (set-buffer-modified-p nil)
+ (setq buffer-undo-list nil))
+ (if display (switch-to-buffer buf))))
+
+;;; Djvu Outline mode
+
+(defun djvu-bookmark (text page)
+ "Create bookmark"
+ (interactive
+ (let ((region (djvu-interactive-region)))
+ (list (read-string "Bookmark: " (buffer-substring-no-properties
+ (car region) (cdr region)))
+ (djvu-doc-page))))
+ ;; Remove newlines that are ignored anyway
+ (setq text (replace-regexp-in-string "\n" " " text))
+ (let (object)
+ (with-current-buffer (djvu-doc-outline-buf)
+ (goto-char (point-min))
+ (if (equal (point) (point-max))
+ (setq object (list 'bookmarks))
+ (condition-case nil
+ (setq object (read (current-buffer)))
+ (error (error "Syntax error in outline"))))
+ (unless (eq 'bookmarks (car object))
+ (error "No bookmarks"))
+ ;; No decoding/encoding necessary if we add another bookmark.
+ (setcdr object (sort (append (cdr object)
+ (list (list text (format "#%d" page))))
+ (lambda (x y)
+ (< (string-to-number (substring (nth 1 x) 1))
+ (string-to-number (substring (nth 1 y) 1))))))
+ (erase-buffer)
+ (insert "(bookmarks")
+ (let (print-escape-newlines)
+ (djvu-insert-outline (cdr object) " "))
+ (insert ")\n")
+ (goto-char (point-min))
+ (undo-boundary))))
+
+(defun djvu-decode-outline (object &optional encode)
+ "Decode Djvu Outline OBJECT. Encode if ENCODE is non-nil."
+ (dolist (elt object)
+ ;; Title
+ (setcar elt
+ (if encode
+ (encode-coding-string (car elt) 'utf-8)
+ (decode-coding-string (car elt) 'utf-8)))
+ ;; URL
+ (setcar (cdr elt)
+ (djvu-resolve-url
+ (if encode
+ (encode-coding-string (cadr elt) 'utf-8)
+ (decode-coding-string (cadr elt) 'utf-8))))
+ ;; Continue with subtree.
+ (djvu-decode-outline (nthcdr 2 elt) encode)))
+
+(defun djvu-insert-outline (object indent)
+ "Insert Outline OBJECT."
+ ;; This function is called recursively.
+ (let ((indent1 (concat indent " ")))
+ (dolist (elt object)
+ (insert (format "\n%s(%S\n%s %S" indent (car elt) indent (nth 1 elt)))
+ (djvu-insert-outline (nthcdr 2 elt) indent1)
+ (insert ")"))))
+
+(defun djvu-process-outline (script &optional doc)
+ (let (object)
+ (with-current-buffer (djvu-doc-outline-buf doc)
+ (save-excursion
+ (goto-char (point-min))
+ (unless (= (point-min) (point-max))
+ (condition-case nil
+ (setq object (read (current-buffer)))
+ (error (error "Syntax error in outline"))))
+ (skip-chars-forward " \t\n")
+ ;; We should have swallowed all bookmarks.
+ (unless (eobp)
+ (error "Syntax error in outline (end of buffer)"))))
+ (unless (eq 'bookmarks (car object))
+ (error "No bookmarks"))
+ (djvu-decode-outline (cdr object) t)
+ (with-temp-buffer
+ (insert "set-outline\n")
+ (when object
+ (insert "(bookmarks")
+ (let ((print-escape-newlines t))
+ (djvu-insert-outline (cdr object) " "))
+ (insert ")\n"))
+ (insert ".\n")
+ (write-region nil nil script t 0))))
+
+;;; Image minor mode
+
+(define-minor-mode djvu-image-mode
+ "Toggle image display of current page."
+ :lighter "Image"
+ :keymap '(([drag-mouse-1] . djvu-mouse-comment)
+ ([C-drag-mouse-1] . djvu-mouse-comment-pushpin)
+ ([S-drag-mouse-1] . djvu-mouse-highlight)
+ ;; (Global) bindings of down-mouse events would take precedence
over
+ ;; drag-mouse events. So we bind the down-mouse events to `ignore'.
+ ([down-mouse-1] . ignore)
+ ([C-down-mouse-1] . ignore)
+ ([S-down-mouse-1] . ignore)
+ ("+" . djvu-image-zoom-in)
+ ("-" . djvu-image-zoom-out))
+ (djvu-image))
+
+(defun djvu-image-zoom-in ()
+ (interactive)
+ (djvu-image (round (* (nth 1 (djvu-doc-image)) 1.2))))
+
+(defun djvu-image-zoom-out ()
+ (interactive)
+ (djvu-image (round (/ (nth 1 (djvu-doc-image)) 1.2))))
+
+(defun djvu-image (&optional isize)
+ "If `djvu-image-mode' is enabled, display image of current Djvu page.
+Otherwise remove the image."
+ (if (not djvu-image-mode)
+ (let (buffer-read-only)
+ (remove-text-properties (point-min) (point-max) '(display nil)))
+ ;; Update image if necessary.
+ (if (or (not (eq (djvu-doc-page) (car (djvu-doc-image))))
+ (and isize
+ (not (eq isize (nth 1 (djvu-doc-image))))))
+ (let ((file (make-temp-file "djvu-"))
+ (isize (or isize
+ (nth 1 (djvu-doc-image))
+ djvu-image-size)))
+ (unwind-protect
+ ;; ddjvu does not send tiff files to stdout
+ (let ((doc djvu-doc)
+ (status (call-process "ddjvu" nil t nil
+ (format "-size=%dx%d" isize isize)
+ "-format=tiff"
+ (format "-page=%d" (djvu-doc-page))
+ (djvu-doc-file)
+ file)))
+ (unless (zerop status)
+ (error "Ddjvu error %s" status))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally file)
+ (djvu-doc-set-image
+ (list (djvu-doc-page doc)
+ isize
+ (create-image (buffer-substring-no-properties
+ (point-min) (point-max))
+ 'tiff t)) doc)))
+ (djvu-delete-file file))))
+ ;; Display image.
+ (let (buffer-read-only)
+ (put-text-property (point-min) (point-max)
+ 'display (nth 2 (djvu-doc-image))))))
+
+(defun djvu-event-to-rect (event)
+ "Convert mouse EVENT to Djvu rect coordinates."
+ (let* ((start (posn-object-x-y (event-start event)))
+ (end (posn-object-x-y (event-end event)))
+ (x1 (car start)) (y1 (cdr start)) (x2 (car end)) (y2 (cdr end))
+ (size (posn-object-width-height (event-start event)))
+ (width (/ (float (car (djvu-doc-pagesize))) (car size)))
+ (height (/ (float (cdr (djvu-doc-pagesize))) (cdr size))))
+ (list (round (* (min x1 x2) width))
+ (round (* (- (cdr size) (max y1 y2)) height))
+ (round (* (max x1 x2) width))
+ (round (* (- (cdr size) (min y1 y2)) height)))))
+
+(defun djvu-mouse-highlight (event)
+ (interactive "e")
+ ;; Mouse events ignore prefix args?
+ (let ((color (djvu-interactive-color djvu-color-highlight)))
+ (djvu-highlight-region "" (read-string (format "(%s) H-Text: " color))
+ (list (djvu-event-to-rect event))
+ color djvu-opacity)))
+
+(defun djvu-mouse-comment (event &optional pushpin)
+ (interactive "e")
+ ;; Mouse events ignore prefix args?
+ (let ((color (djvu-interactive-color djvu-color-highlight)))
+ (djvu-comment "" (read-string (format "(%s) C-Text: " color))
+ (djvu-event-to-rect event) nil
+ (djvu-color-background color djvu-color-background
+ djvu-opacity)
+ nil pushpin)))
+
+(defun djvu-mouse-comment-pushpin (event)
+ (interactive "e")
+ (djvu-mouse-comment event t))
+
+;;; clean up
+
+(defun djvu-make-clean ()
+ "Remove Outline and Annotations."
+ (interactive)
+ (when (yes-or-no-p "Remove Outline and Annotations ")
+ (djvu-djvused djvu-doc nil "-e"
+ "select; remove-ant; set-outline;\n." "-s")
+ (djvu-init-page)))
+
+
+(provide 'djvu)
+;;; djvu.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [ELPA-diffs] /srv/bzr/emacs/elpa r156: new package djvu.el,
Roland Winkler <=