1 ;;; djvu.el --- Edit and view Djvu files via djvused
3 ;; Copyright (C) 2011 Free Software Foundation, Inc.
5 ;; Author: Roland Winkler <winkler@gnu.org>
9 ;; This file is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; djvu.el is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with djvu.el. If not, see <http://www.gnu.org/licenses/>.
24 ;; This package is a front end for the command-line program djvused
25 ;; from DjVuLibre, see http://djvu.sourceforge.net/. It assumes you
26 ;; have the programs djvused, djview, and ddjvu installed.
28 ;; A normal work flow is as follows:
30 ;; To visit a djvu file type M-x fjvu-find-file. This command is the
31 ;; only entry point to this package. You may want to bind this
32 ;; command to a key you like. I use
34 ;; (global-set-key "\C-cd" 'djvu-find-file)
36 ;; If you use this command to visit file foo.djvu, it puts you into
37 ;; the (read-only) buffer foo@djvu. Normally, this buffer is all you
40 ;; The menu bar of this buffer lists most of the commands with their
41 ;; repsective key bindings. For example, you can:
43 ;; - Use `g' to go to the page you want. (Yes, this package operates on
44 ;; one page at a time. I guess that anything else would be too slow
45 ;; for large documents.)
47 ;; - Use `v' to (re)start djview using the position in foo.djvu
48 ;; matching where point is in foo@djvu. (I find djview fast enough
49 ;; for this, even for larger documents.)
51 ;; - To highlight a region in foo.djvu mark the corresponding region
52 ;; in foo@djvu (as usual, `transient-mark-mode' comes handy for
53 ;; this). Then type `h' and add a comment in the minibuffer if you
54 ;; like. Type C-x C-s to save this editing. Then type `v' to
55 ;; (re)start djview to show what you have done.
57 ;; - Type i to enable `djvu-image-mode', a minor mode displaying the
58 ;; current page as an image. Then
59 ;; drag-mouse-1 defines a region where to put a comment,
60 ;; C-drag-mouse-1 defines a region where to put a pushpin comment,
61 ;; S-drag-mouse-1 defines a region to highlight
63 ;; - The editing of the text, annotation and outline (bookmark) layers
64 ;; really happens in the buffers foo@djvu-t.el, foo@djvu-a.el, and
65 ;; foo@djvu-o.el. (The djvused syntax used in these buffers is so
66 ;; close to elisp that it was natural to give these buffers a
67 ;; djvu-edit-mode that is derived from emacs-lisp-mode.)
69 ;; You can check what is happening by switching to these buffers.
70 ;; The respective switching commands put point in these buffers such
71 ;; that it matches where you were in foo@djvu.
73 ;; In these buffers, the menu bar lists a few low-level commands
74 ;; available for editing these buffers directly. If you know the
75 ;; djvused syntax, sometimes it can also be helpful to do such
78 ;; But wait: the syntax in the annotations buffer foo@djvu-a.el is a
79 ;; slightly modified djvused syntax. djvused can only highlight
80 ;; rectangles. So the highlighting of larger regions of text must use
81 ;; multiple rectangles (i.e., multiple djvused "mapareas"). To make
82 ;; editing easier, these are combined in the buffer foo@djvu-a.el.
83 ;; (Before saving these things, they are converted using the proper
86 ;; When you visit a djvu file, djvu-mode recognizes mapareas belonging
87 ;; together by checking that "everything else in these mapareas except
88 ;; for the rects" is the same. So if you entered a (unique) comment,
89 ;; this allows djvu-mode to combine all the mapareas when you visit
90 ;; such a file the second time. Without a comment, this fails!
92 ;; A second difference between what is displayed in the djvu buffers
93 ;; and the input/output of djvused refers to nonascii characters. I
94 ;; am using djvused from DjVuLibre-3.5.22 which handles utf-8 by
95 ;; backslash sequences. So djvu mode converts these backslash
96 ;; sequences into the corresponding utf-8 characters. (More recent
97 ;; versions of djvused can do this conversion, too.)
99 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
102 ;; (see /usr/share/doc/libdjvulibre-dev/djvu3spec.djvu)
104 ;; Supported area attributes rect oval poly line text
105 ;; (none)/(xor)/(border c) X X X X X
107 ;; (border_avis) X X X
108 ;; (hilite color) / (opacity o) X
109 ;; (arrow) / (width w) / (lineclr c) X
110 ;; (backclr c) / (textclr c) / (pushpin) X
112 ;; c = #RRGGBB t = thickness (1..32)
113 ;; o = opacity = 0..100
117 (defvar djvu-color-highlight "yellow"
118 "Default color for highlighting.")
120 (defvar djvu-color-himark "red"
121 "Default color for highmarking.")
123 (defvar djvu-color-url "blue"
124 "Default color for URLs.")
126 (defvar djvu-color-background "white"
127 "Default background.")
129 (defvar djvu-color-alist
130 ;; If the keys are strings, they are directly compatible with what
131 ;; we get back from something like `completing-read'.
132 '(("red" . "#FF0070")
133 ("green" . "#00FF00")
135 ("yellow" . "#EEFF00")
136 ("white" . "#FFFFFF"))
137 "Alist of colors for highlighting.")
139 (defvar djvu-opacity 50
140 "Default opacity for Highlighting.")
142 (defvar djvu-coords-justify 0.02
143 "Upper threshold for justifying rect coordinates.")
145 (defvar djvu-fill-column 50
146 "Fill column for Djvu annotations.")
148 (defvar djvu-all-buffer "*djvu*"
149 "Buffer for `all' operations.")
151 (defvar djvu-buffer-name-extensions
152 '("@djvu" "@djvu-t.el" "@djvu-a.el" "@djvu-o.el")
153 "Extensions for Djvu buffer names.
154 This is a list with four elements (READ TEXT ANNOT OUTLINE).")
156 (defvar djvu-resolve-url nil
157 "Flag for resolving internal URLs.
158 If 'long replace short page numbers by long FileIDs.
159 If 'short replace long FileIDs by short page numbers.
162 (defvar djvu-image-size 1024
163 "Size of internally displayed image.")
165 ;; Internal variables
167 (defvar djvu-test nil
168 "If non-nil do not process / delete djvused scripts.")
169 ;; (setq djvu-test t) (setq djvu-test nil)
172 "Internal look-up table (a vector) for each Djvu document.
173 For the different buffers of one Djvu document the buffer-local
174 value of this variable is the same vector holding all the
175 relevant information about this document. This way, we obtain a
176 \"document-local\" variable, where changes are seen in all buffers
177 refering to this Djvu document.")
178 (make-variable-buffer-local 'djvu-doc)
182 ;; "read" refers to the text-only display of djvu files inside emacs
183 ;; "view" refers to external graphical viewers (default djview)
187 (dolist (elt '(file basename text-buf read-buf annot-buf outline-buf
188 page pagemax page-id pagesize pos view-proc image))
189 (eval (list 'defsubst (intern (concat "djvu-doc-" (symbol-name elt)))
190 '(&optional doc) `(aref (or doc djvu-doc) ,count)))
191 (eval (list 'defsubst (intern (concat "djvu-doc-set-" (symbol-name elt)))
192 '(val &optional doc) `(aset (or doc djvu-doc) ,count val)))
193 (setq count (1+ count)))
194 (eval `(defconst djvu-doc-length ,count))))
196 (defun djvu-switch-text ()
197 "Switch to Djvu Text buffer."
199 (let ((pos (djvu-read-pos)))
200 (switch-to-buffer (djvu-doc-text-buf))
201 (djvu-locate-pos 'word pos)))
203 (defun djvu-switch-annot ()
204 "Switch to Djvu Annotations buffer."
206 (let ((pos (djvu-read-pos)))
207 (switch-to-buffer (djvu-doc-annot-buf))
208 (djvu-locate-pos 'rect pos)))
210 (defun djvu-switch-outline ()
211 "Switch to Djvu Outline buffer."
213 ;; Try to locate the current page in the outline buffer.
214 ;; If this page is not defined, try to locate the nearest preceding page.
215 (let ((page (djvu-doc-page)) pnt)
216 (with-current-buffer (djvu-doc-outline-buf)
217 (goto-char (point-min))
218 (if (looking-at "(bookmarks")
219 (while (and (< 0 page)
220 (not (setq pnt (re-search-forward
221 (format "\"#%d\"" page) nil t))))
222 (setq page (1- page)))))
223 (switch-to-buffer (djvu-doc-outline-buf))
224 (if pnt (goto-char pnt))))
226 (defun djvu-switch-read ()
227 "Switch to Djvu Read buffer."
229 (switch-to-buffer (djvu-doc-read-buf)))
231 (defun djvu-goto-page (page)
232 "Goto PAGE of Djvu document."
234 (let ((str (read-string (format "Page (f, 1-%d, l): " (djvu-doc-pagemax)))))
235 (list (cond ((string-match "\\`f" str) 1)
236 ((string-match "\\`l" str) (djvu-doc-pagemax))
237 ((string-match "\\`[[:digit:]]+\\'" str)
238 (string-to-number str))
239 (t (error "Page `%s' invalid" str))))))
240 (if (or (not (integerp page))
241 (<= page 0) (< (djvu-doc-pagemax) page))
242 (error "Page `%s' out of range" page))
243 (djvu-init-page djvu-doc page))
245 (defun djvu-next-page (n)
247 (djvu-goto-page (+ (djvu-doc-page) n)))
249 (defun djvu-prev-page (n)
251 (djvu-goto-page (- (djvu-doc-page) n)))
253 (defun djvu-set-color-highlight (color)
254 "Set color for highlighting based on `djvu-color-alist'."
255 (interactive (list (completing-read "Color: " djvu-color-alist nil t)))
256 (setq djvu-color-highlight color))
258 (defun djvu-kill-view (&optional doc)
259 (when (djvu-doc-view-proc doc)
260 (unless (memq (process-status (djvu-doc-view-proc doc))
262 (kill-process (djvu-doc-view-proc doc)))
263 (djvu-doc-set-view-proc nil doc)))
265 (defun djvu-kill-doc (&optional doc)
269 (mapc 'kill-buffer (list (djvu-doc-text-buf doc) (djvu-doc-read-buf doc)
270 (djvu-doc-annot-buf doc) (djvu-doc-outline-buf doc))))
272 (defsubst djvu-delete-file (script)
273 (unless djvu-test (delete-file script)))
275 (defun djvu-save (&optional doc query)
278 (let ((pos (djvu-read-pos))
279 (text-modified (buffer-modified-p (djvu-doc-text-buf doc)))
280 (annot-modified (buffer-modified-p (djvu-doc-annot-buf doc)))
281 (outline-modified (buffer-modified-p (djvu-doc-outline-buf doc)))
283 (when (and (or text-modified annot-modified outline-modified)
285 (yes-or-no-p (format "Save %s? " (djvu-doc-basename doc)))))
288 (setq script (make-temp-file "djvu-el-"))
289 (if text-modified (djvu-process-text script doc))
290 (if annot-modified (djvu-process-annot script doc))
291 (if outline-modified (djvu-process-outline script doc))
292 (djvu-djvused doc nil "-f" script "-s")
293 (dolist (buf (list (djvu-doc-text-buf doc) (djvu-doc-annot-buf doc)
294 (djvu-doc-outline-buf doc) (djvu-doc-read-buf doc)))
295 (with-current-buffer buf (set-buffer-modified-p nil)))
296 (if text-modified (djvu-locate-read-pos pos)))
297 (djvu-delete-file script)))))
299 (defun djvu-modified ()
300 "Mark Djvu Read buffer as modified if necessary.
301 Used in `post-command-hook' of the Djvu Outline, Text and Read buffers."
302 (with-current-buffer (djvu-doc-read-buf)
303 (set-buffer-modified-p (or (buffer-modified-p (djvu-doc-outline-buf))
304 (buffer-modified-p (djvu-doc-text-buf))
305 (buffer-modified-p (djvu-doc-annot-buf))))))
307 (defun djvu-process (&optional doc view)
309 (interactive (list djvu-doc t))
311 (if view (djvu-view doc)))
313 (defun djvu-djvused (doc buffer &rest args)
314 ;; BUFFER is nil if we update the Djvu file.
315 (unless (or buffer (file-writable-p (djvu-doc-file doc)))
316 (error "File `%s' not writable"
317 (abbreviate-file-name (djvu-doc-file doc))))
318 (unless (and (not buffer) djvu-test)
319 (let ((status (apply 'call-process "djvused" nil buffer nil
320 (djvu-doc-file doc) args)))
321 (unless (zerop status)
322 (error "Djvused error %s (args: %s)" status args)))))
324 (defun djvu-hide-hash (&optional recover)
325 (let* ((old (concat " " (if recover "@!@" "#") "\\([[:xdigit:]]\\)"))
326 (new (concat " " (if recover "#" "@!@") "\\1")))
327 (goto-char (point-min))
328 (while (re-search-forward old nil t) (replace-match new))))
330 (defun djvu-interactive-region ()
331 "Return active region for use in interactive calls."
334 (setq beg (region-beginning)
336 (setq beg (point) end (1+ (point))))
337 (cons (if (get-text-property beg 'word)
338 (djvu-property-beg beg 'word)
339 (next-single-property-change beg 'word nil end))
340 (if (get-text-property (1- end) 'word)
341 (djvu-property-end end 'word)
342 (previous-single-property-change end 'word nil beg)))))
344 (defun djvu-interactive-color (color)
345 "Return color specification for use in interactive calls."
346 (let ((colnum (or (and (consp current-prefix-arg)
347 (1- (/ (car current-prefix-arg) 4)))
348 (and (integerp current-prefix-arg)
349 current-prefix-arg))))
350 (if (and colnum (>= colnum (length djvu-color-alist)))
351 (error "Color undefined"))
352 (if colnum (car (nth colnum djvu-color-alist)) color)))
354 (defun djvu-interactive-url (&optional color interrupt)
355 "Return URL specification for use in interactive calls."
356 (unless color (setq color djvu-color-url))
357 (let ((fmt (format "(%s) Page URL: " (or color djvu-color-url)))
358 (page "") num ignore)
359 (while (and (not ignore)
360 (or (not (integerp (setq num (string-to-number page))))
361 (< num 1) (< (djvu-doc-pagemax) num)))
362 (setq page (read-string fmt))
363 (if (and interrupt (string= "" page)) (setq ignore t)))
364 (unless ignore (concat "#" page))))
366 (defsubst djvu-color-string-to-hex (color i)
367 "Convert rgb COLOR string (part I) to hex number."
368 (string-to-number (substring-no-properties
369 (cdr (assoc color djvu-color-alist))
370 (1+ (* i 2)) (+ 3 (* i 2))) 16))
372 (defun djvu-color-background (color background opacity)
373 "For rgb COLOR and BACKGROUND apply OPACITY.
374 Return the new rgb color string."
376 ;; Why opacity squared??
377 (a (/ (float (* opacity opacity)) 10000))
380 (setq str (concat str (format "%X"
381 (round (+ (* a (djvu-color-string-to-hex color i))
382 (* b (djvu-color-string-to-hex background i))))))))))
386 (defvar djvu-read-mode-map
387 (let ((km (make-sparse-keymap)))
388 (define-key km "i" 'djvu-image-mode)
389 (define-key km "v" 'djvu-view)
390 (define-key km "\C-c\C-v" 'djvu-view)
391 (define-key km "n" 'djvu-next-page)
392 (define-key km "p" 'djvu-prev-page)
393 (define-key km "g" 'djvu-goto-page)
394 (define-key km "k" 'djvu-kill-doc)
395 (define-key km "\C-c\C-c" 'djvu-process)
396 (define-key km "\C-x\C-s" 'djvu-save)
398 (define-key km "h" 'djvu-highlight)
399 (define-key km "u" 'djvu-url)
400 (define-key km "a" 'djvu-switch-annot)
401 (define-key km "A" 'djvu-display-annot-all)
403 (define-key km "c" 'djvu-comment)
404 (define-key km "C" 'djvu-comment-pushpin)
405 (define-key km "b" 'djvu-bookmark)
406 (define-key km "m" 'djvu-himark)
407 (define-key km "o" 'djvu-switch-outline)
409 (define-key km "s" 'djvu-split-word)
410 (define-key km "w" 'djvu-merge-words)
411 (define-key km "l" 'djvu-merge-lines)
413 (define-key km "t" 'djvu-switch-text)
414 (define-key km "T" 'djvu-display-text-all)
416 "Keymap for Djvu Read Mode.
417 This is a child of `special-mode-map'.")
420 djvu-read-menu djvu-read-mode-map "Djvu Menu"
422 ["View File" djvu-view t]
423 ["Image File" djvu-image-mode t]
424 ["Go to Page" djvu-goto-page t]
425 ["Process Doc" djvu-process t]
426 ["Save Doc" djvu-save t]
428 ["Split Word" djvu-split-word t]
429 ["Merge Words" djvu-merge-words t]
430 ["Merge Lines" djvu-merge-lines t]
431 ["Switch to Text" djvu-switch-text t]
433 ["Highlight Region" djvu-highlight t]
434 ["URL over Region" djvu-url t]
435 ["Himark Region" djvu-himark t]
436 ["Add Comment" djvu-comment t]
437 ["Add Comment w/pushpin" djvu-comment-pushpin t]
438 ["Switch to Annotations" djvu-switch-annot t]
440 ["Show all Text" djvu-display-text-all t]
441 ["Show all Annotations" djvu-display-annot-all t]
442 ["Resolve all URLs" djvu-resolve-all-urls t]
443 ["Process all Annotations" djvu-process-all t]
444 ["Remove Annot / Outline" djvu-make-clean t]
446 ["Add Bookmark" djvu-bookmark t]
447 ["Switch to Outline" djvu-switch-outline t]
449 ["Quit Djvu" quit-window t]
450 ["Kill Djvu buffers" djvu-kill-doc t]))
452 (define-derived-mode djvu-read-mode special-mode "Djview"
453 "Mode for reading Djvu files."
454 (setq mode-line-buffer-identification
455 (list 24 (buffer-name) " "
456 '(:eval (format "p%d" (djvu-doc-page))))))
458 (defvar djvu-edit-mode-map
459 (let ((km (make-sparse-keymap)))
460 (define-key km "\C-c\C-r" 'djvu-switch-read)
461 (define-key km "\C-c\C-g" 'djvu-goto-page)
462 (define-key km "\C-c\C-s" 'djvu-split-word-internal)
463 (define-key km "\C-c\C-m" 'djvu-merge-words-internal)
464 (define-key km "\C-c\M-m" 'djvu-merge-lines-internal)
465 (define-key km "\C-c\C-c" 'djvu-process)
466 (define-key km "\C-x\C-s" 'djvu-save)
467 (define-key km "\C-c\C-v" 'djvu-view)
468 (define-key km "\C-c\C-k" 'djvu-kill-doc)
470 "Keymap for Djvu Annot Mode.
471 This is a child of `text-mode-map'.")
474 djvu-annot-menu djvu-edit-mode-map "Djvu Menu"
476 ["Go to Page" djvu-goto-page t]
477 ["Switch to Read" djvu-switch-read t]
478 ["Process Doc" djvu-process t]
479 ["Save Doc" djvu-save t]
481 ["Switch to Text" djvu-switch-text t]
482 ["Split Word" djvu-split-word-internal t]
483 ["Merge Words" djvu-merge-words-internal t]
484 ["Merge Lines" djvu-merge-lines-internal t]
486 ["Switch to Annot" djvu-switch-annot t]
488 ["Quit Djvu" quit-window t]
489 ["Kill Djvu buffers" djvu-kill-doc t]))
491 (define-derived-mode djvu-edit-mode emacs-lisp-mode "Djvu Edit"
492 "Mode for editing (parts of) Djvu files."
493 (setq mode-line-buffer-identification
494 (list 24 (buffer-name) " "
495 '(:eval (format "p%d" (djvu-doc-page))))))
500 (defun djvu-find-file (file &optional page view)
501 "Read and edit Djvu FILE on PAGE.
502 If VIEW is non-nil start external viewer."
504 (list (read-file-name "Find Djvu file: " nil nil nil nil
506 (or (equal "djvu" (file-name-extension f))
507 (file-directory-p f))))
508 (prefix-numeric-value current-prefix-arg)))
509 (unless page (setq page 1))
510 (setq file (expand-file-name file))
511 (unless (file-regular-p file)
512 (error "Cannot open Djvu file `%s'." file))
513 ;; Initialize `djvu-doc' for FILE.
514 (let* ((basename (file-name-sans-extension
515 (file-name-nondirectory file)))
516 (read-buf (concat basename (nth 0 djvu-buffer-name-extensions)))
517 (text-buf (concat basename (nth 1 djvu-buffer-name-extensions)))
518 (annot-buf (concat basename (nth 2 djvu-buffer-name-extensions)))
519 (outline-buf (concat basename (nth 3 djvu-buffer-name-extensions)))
520 (buffers (list text-buf read-buf annot-buf outline-buf))
522 ;; Do nothing if we are already visiting FILE such that all required
523 ;; buffers are properly defined. If some buffers were killed
524 ;; do not attempt to recycle the remaining buffers.
525 (if (eval (cons 'and (mapcar 'get-buffer buffers)))
526 (with-current-buffer read-buf
528 (setq doc (make-vector djvu-doc-length nil))
529 (dolist (buf buffers)
530 (if (get-buffer buf) (kill-buffer buf)))
531 (djvu-doc-set-file file doc)
532 (djvu-doc-set-basename basename doc)
533 (djvu-doc-set-text-buf (get-buffer-create text-buf) doc)
534 (djvu-doc-set-read-buf (get-buffer-create read-buf) doc)
535 (djvu-doc-set-annot-buf (get-buffer-create annot-buf) doc)
536 (djvu-doc-set-outline-buf (get-buffer-create outline-buf) doc)
537 ;; Initialize all buffers.
538 (dolist (buf (list (djvu-doc-text-buf doc) (djvu-doc-annot-buf doc)
539 (djvu-doc-outline-buf doc)))
540 (with-current-buffer buf
543 (cd (file-name-directory (djvu-doc-file)))
544 (add-hook 'post-command-hook 'djvu-modified nil t)))
545 (with-current-buffer (djvu-doc-read-buf doc)
548 (cd (file-name-directory (djvu-doc-file)))
549 (add-hook 'post-command-hook 'djvu-modified nil t))
550 (djvu-init-page doc page))
551 (if view (djvu-view doc))
552 (switch-to-buffer read-buf)))
554 (defun djvu-init-page (&optional doc page)
555 "For Djvu DOC initialize PAGE."
556 (if (djvu-doc-pagemax doc) (djvu-save doc t))
557 (djvu-doc-set-pos nil doc)
558 (if page (djvu-doc-set-page page doc))
559 (let* ((doc (or doc djvu-doc))
560 (new (not (djvu-doc-pagemax doc)))
563 (djvu-djvused doc t "-e"
564 (format "%sselect %d; size; print-txt; print-ant;"
565 (if new "n; ls; print-outline; " "")
566 (djvu-doc-page doc)))
567 (goto-char (point-min))
570 (djvu-doc-set-pagemax (read (current-buffer)) doc)
574 (skip-chars-forward " \t\n")
575 (looking-at "\\(?:\\([0-9]+\\)[ \t]+\\)?\\([PIAT]\\)[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t\n]+\\)$"))
577 ;; page-id is an alist with elements (PAGE-NUM . FILE-ID)
578 (push (cons (match-string 1) (match-string 4)) page-id))
579 (goto-char (match-end 0)))
580 (unless (eq (djvu-doc-pagemax doc) (length page-id))
581 (error "Page id list broken"))
582 (djvu-doc-set-page-id (nreverse page-id) doc))
584 (skip-chars-forward " \t\n")
585 (when (looking-at "(bookmarks")
586 (setq object (read (current-buffer)))
587 (djvu-decode-outline (cdr object))
588 (with-current-buffer (djvu-doc-outline-buf doc)
589 (insert "(bookmarks")
590 (let (print-escape-newlines)
591 (djvu-insert-outline (cdr object) " "))
593 (goto-char (point-min))
594 (set-buffer-modified-p nil)
595 (setq buffer-undo-list nil))))
598 (skip-chars-forward " \t\n")
599 (if (looking-at "width=\\([[:digit:]]+\\)[ \t]+height=\\([[:digit:]]+\\)$")
600 (djvu-doc-set-pagesize (cons (string-to-number (match-string 1))
601 (string-to-number (match-string 2))) doc)
602 (error "No pagesize"))
605 (goto-char (match-end 0))
606 (skip-chars-forward " \t\n")
607 (setq object (if (looking-at "(\\(page\\|column\\|region\\|para\\|line\\|word\\|char\\)")
608 (read (current-buffer))))
609 (djvu-decode-text object)
610 (with-current-buffer (djvu-doc-text-buf doc)
612 (djvu-insert-text object "")
614 (goto-char (point-min))
615 (set-buffer-modified-p nil)
616 (setq buffer-undo-list nil))
618 ;; Set up read buffer
619 (djvu-init-read doc object)
621 ;; Set up annotations buffer:
624 (narrow-to-region (point) (point-max))
627 (while (progn (skip-chars-forward " \t\n") (not (eobp)))
628 (if (looking-at "(\\(background\\|zoom\\|mode\\|align\\|maparea\\|metadata\\)\\>")
629 (push (read (current-buffer)) object)
630 (error "Unknown annotation `%s'" (buffer-substring-no-properties
631 (point) (line-end-position)))))
632 ;; To simplify the editing of annotations, identify mapareas (rect)
633 ;; sharing the same text string.
635 (if (not (eq 'maparea (car elt)))
637 (setcar (cdr elt) (decode-coding-string (nth 1 elt) 'utf-8))
638 (setcar (nthcdr 2 elt) (decode-coding-string (nth 2 elt) 'utf-8))
639 (cond ((eq 'rect (car (nth 3 elt))) ; rect
640 (let ((rect (djvu-rect (nth 3 elt)))
642 (setcdr (nthcdr 2 elt) (nthcdr 4 elt)) ; remove rect destructively
643 ;; The new elements of alist are cons cells, where the car is the
644 ;; maparea without rect, and the cdr is the list of rect areas.
645 ;; Even if we have just an empty string, we still want to massage
647 (if (or (string= "" (nth 2 elt))
648 (not (setq e (assoc elt alist))))
649 (push (cons elt (list rect)) alist)
650 (setcdr e (cons rect (cdr e))))))
651 ((eq 'text (car (nth 3 elt))) ; text
652 (setcar (nthcdr 3 elt) (djvu-rect (nth 3 elt)))
654 (t (push elt alist)))))
655 ;; Pretty print annotations.
656 (with-current-buffer (djvu-doc-annot-buf doc)
657 (let ((standard-output (current-buffer))
658 print-escape-newlines)
661 (cond ((consp (car elt)) ;; maparea with list of rects
663 (insert (format "(maparea %S\n %S\n ("
664 (djvu-resolve-url (nth 1 c) doc) (nth 2 c))
665 (mapconcat 'prin1-to-string (cdr elt) "\n ") ")\n " ; rect
666 (mapconcat 'prin1-to-string (nthcdr 3 c) " ") ; rest
668 ((not (eq 'maparea (car elt)))
670 ((eq 'text (car (nth 3 elt))) ; text
671 (insert (format "(maparea %S\n %S\n " (nth 1 elt) (nth 2 elt))
672 (mapconcat 'prin1-to-string (nthcdr 3 elt) " ") ; rest
674 (t (error "Djvu maparea %s undefined" (car (nth 3 elt)))))
677 (goto-char (point-max))
678 (set-buffer-modified-p nil)
679 (setq buffer-undo-list nil)))))
681 (defun djvu-resolve-url (url &optional doc)
682 "Resolve internal URLs. See variable `djvu-resolve-url'."
683 (cond ((eq 'long djvu-resolve-url)
684 ;; Replace page number by file id
685 (cond ((string-match "\\`#[0-9]+\\'" url)
686 (let ((page-id (assoc (substring-no-properties url 1)
687 (djvu-doc-page-id doc))))
689 (concat "#" (cdr page-id))
690 (error "Page id broken: %s" url))))
691 ((string-match "\\`#" url)
692 (if (rassoc (substring-no-properties url 1)
693 (djvu-doc-page-id doc))
695 (error "Page id broken: %s" url)))
696 (t url))) ; some other URL
697 ((eq 'short djvu-resolve-url)
698 ;; Replace file id by page number
699 (cond ((string-match "\\`#[0-9]+\\'" url)
701 ((string-match "\\`#" url)
702 (let ((page-id (rassoc (substring-no-properties url 1)
703 (djvu-doc-page-id doc))))
705 (concat "#" (car page-id))
706 (error "Page id broken: %s" url))))
707 (t url))) ; some other URL
708 (t url))) ; do nothing
710 (defun djvu-resolve-all-urls (dir)
711 "Resolve all internal URLs in a Djvu file."
713 (list (intern (completing-read "Direction: " '((long) (short)) nil t))))
714 (if (djvu-modified) (error "Djvu file should be saved"))
715 (let ((page-id (djvu-doc-page-id djvu-doc))
716 (djvu-all-buffer (generate-new-buffer " *djvu*"))
717 (djvu-resolve-url dir))
718 (djvu-display-annot-all)
719 (with-current-buffer djvu-all-buffer
720 (goto-char (point-min))
721 (cond ((eq dir 'long)
722 (while (re-search-forward "^(maparea[ \t]+\"#\\([0-9]+\\)\"" nil t)
723 (replace-match (cdr (assoc (match-string 1) page-id))
726 (while (re-search-forward "^(maparea[ \t]+\"#\\([^\"]+\\)\"" nil t)
727 (replace-match (car (rassoc (match-string 1) page-id))
730 (kill-buffer djvu-all-buffer)
731 (with-current-buffer (djvu-doc-outline-buf)
732 (set-buffer-modified-p t))
735 (defun djvu-rect (rect &optional back)
736 "Convert (rect xmin ymin width height) to (rect xmin ymin xmax ymax).
737 If BACK is non-nil do inverse transformation."
738 (let* ((f (if back '- '+))
739 (lst (list (nth 0 rect) (nth 1 rect) (nth 2 rect)
740 (funcall f (nth 3 rect) (nth 1 rect))
741 (funcall f (nth 4 rect) (nth 2 rect)))))
742 ;; Only for back transforms we might get an error...
743 (if (or (> 0 (nth 3 lst)) (> 0 (nth 4 lst)))
744 (error "Annotation rect dimensions %s, %s" (nth 3 lst) (nth 4 lst)))
747 (defun djvu-view (&optional doc)
748 "Start Djview for DOC."
749 (interactive (list djvu-doc))
750 (if (not (window-system))
751 (message "No window system available")
753 (let* ((djvu-doc doc)
754 (pos (or (djvu-doc-pos) (djvu-read-pos)))
755 (px (/ (float (car pos))
756 (float (car (djvu-doc-pagesize)))))
757 (py (- 1 (/ (float (cdr pos))
758 (float (cdr (djvu-doc-pagesize))))))
759 process-connection-type) ; Use a pipe.
760 (if (or (< px 0) (< 1 px) (< py 0) (< 1 py))
761 (error "px=%s, py=%s out of range" px py))
762 (djvu-doc-set-pos nil)
763 (djvu-doc-set-view-proc
764 (start-process "djview" nil "djview"
765 (format "-page=%d" (djvu-doc-page))
766 (format "-showposition=%06f,%06f" px py)
771 (defun djvu-split-word (pos)
772 "Split word at position POS.
773 This command operates on the read buffer."
775 (let ((beg (djvu-property-beg pos 'word))
776 (rpos (djvu-read-pos pos)))
777 (with-current-buffer (djvu-doc-text-buf)
778 (djvu-split-word-internal (djvu-locate-pos 'word rpos)
780 ;; Things get rather confusing without updating the read buffer.
781 ;; So we better save everything.
784 (defun djvu-split-word-internal (wpos split)
785 "Split word at position WPOS at character position SPLIT.
786 This command operates on the text buffer."
789 (pps (parse-partial-sexp (line-beginning-position) pnt)))
790 (unless (nth 3 pps) (error "Not inside string"))
791 (list pnt (1- (- pnt (nth 8 pps))))))
794 (skip-chars-forward " \t")
796 (let ((indent (buffer-substring-no-properties
797 (line-beginning-position) wpos))
801 (setq word (read (current-buffer)))
802 (unless (eq 'word (car word)) (error "invalid")))
803 (error (error "Syntax error in raw text")))
804 (if (or (< split 1) (<= (length (nth 5 word)) split))
805 (error "nothing to split"))
806 (delete-region wpos (point))
807 ;; To split the bounding box horizontally, we take the fraction
808 ;; of the number of characters in each fragment. This scheme
809 ;; is only approximate, but it is better than nothing.
810 (let ((frac (round (* (/ (float split) (length (nth 5 word)))
811 (- (nth 3 word) (nth 1 word))))))
812 (djvu-insert-text (list 'word (nth 1 word) (nth 2 word)
813 (+ (nth 1 word) frac) (nth 4 word)
814 (substring (nth 5 word) 0 split)) "")
816 (djvu-insert-text (list 'word (+ (nth 1 word) frac 1) (nth 2 word)
817 (nth 3 word) (nth 4 word)
818 (substring (nth 5 word) split)) ""))))
820 (defun djvu-merge-words (beg end)
821 "Merge words between positions BEG and END.
822 This command operates on the read buffer."
824 (let ((bpos (djvu-read-pos beg))
825 (epos (djvu-read-pos (1- end))))
826 (with-current-buffer (djvu-doc-text-buf)
827 (djvu-merge-words-internal (djvu-locate-pos 'word bpos)
828 (djvu-locate-pos 'word epos))))
829 ;; Things get rather confusing without updating the read buffer.
830 ;; So we better save everything.
833 (defun djvu-merge-words-internal (beg end)
834 "Merge words between positions BEG and END.
835 This command operates on the text buffer."
839 (if (bolp) (setq end (1- end)))
842 (skip-chars-forward " \t")
845 (while (< (point) end)
846 (push (read (current-buffer)) words)
847 (unless (eq 'word (caar words)) (error "invalid")))
848 (error (error "Syntax error in raw text")))
849 (delete-region beg (point))
850 (let ((object (apply 'list 'word 0 0 0 0 (nreverse words))))
851 (djvu-process-text-bbox object 0 (make-vector 3 nil))
852 (setcdr (nthcdr 4 object) (list (mapconcat (lambda (w) (nth 5 w))
853 (nthcdr 5 object) "")))
854 (djvu-insert-text object "")))
857 (defun djvu-merge-lines (beg end)
858 "Merge lines between positions BEG and END.
859 This command operates on the read buffer."
861 (let ((bpos (djvu-read-pos beg))
862 (epos (djvu-read-pos (1- end))))
863 (with-current-buffer (djvu-doc-text-buf)
864 (djvu-merge-lines-internal (djvu-locate-pos 'word bpos)
865 (djvu-locate-pos 'word epos))))
866 ;; Things get rather confusing without updating the read buffer.
867 ;; So we better save everything.
870 (defun djvu-merge-lines-internal (beg end)
871 "Merge lines between positions BEG and END.
872 This command operates on the text buffer."
874 ;; Calculate proper value of END
877 (unless (looking-at "[ \t]*(line ")
878 (re-search-backward "^[ \t]*(line ")
881 ;; Calculate proper value of BEG
884 (unless (looking-at "[ \t]*(line ")
885 (re-search-backward "^[ \t]*(line "))
886 (skip-chars-forward " \t")
888 (unless (< beg end) (error "Nothing to merge"))
889 ;; Parsing fails if the words belong to different paragraphs,
890 ;; regions or columns. We would have to determine the lowest common
891 ;; object level of these words. Then we could possibly merge
892 ;; everything (!) within this level
893 (if (re-search-forward "^[ \t]*\\(?:para\\|region\\|column\\)" end t)
894 (error "Cannot merge paragraphs, regions or columns"))
898 (while (<= (point) end)
899 (cond ((looking-at "[ \t]*(word ")
900 (push (read (current-buffer)) words))
901 ((not (looking-at "[ \t]*(line "))
904 (error (error "Syntax error in raw text")))
907 (while (let ((start (point)))
910 (progn (goto-char start) nil))))
911 (delete-region beg (point))
913 (let ((indent (buffer-substring-no-properties
914 (line-beginning-position) (point)))
915 (object (apply 'list 'line 0 0 0 0 (nreverse words))))
916 (djvu-process-text-bbox object 0 (make-vector 3 nil))
917 (delete-region (line-beginning-position) (point))
918 (djvu-insert-text object indent)))
921 (defun djvu-decode-text (object &optional encode)
922 (if (stringp (nth 5 object))
923 (setcar (nthcdr 5 object)
925 (encode-coding-string (nth 5 object) 'utf-8)
926 (decode-coding-string (nth 5 object) 'utf-8)))
927 (dolist (elt (nthcdr 5 object))
928 (djvu-decode-text elt encode))))
930 (defun djvu-insert-text (object indent)
931 ;; This function is called recursively.
933 (mapconcat 'prin1-to-string
934 (list (nth 0 object) (nth 1 object) (nth 2 object)
935 (nth 3 object) (nth 4 object)) " "))
936 (let ((tail (nthcdr 5 object))
937 (indent (concat indent " ")))
938 (if (stringp (car tail))
939 ;; use `prin1-to-string' as we use this function both for
940 ;; utf-8 and encoded stuff.
941 (insert " " (prin1-to-string (car tail)) ")")
944 (djvu-insert-text elt indent))
947 (defun djvu-process-text (script &optional doc)
948 (let ((doc (or doc djvu-doc))
950 (with-current-buffer (djvu-doc-text-buf doc)
952 (goto-char (point-min))
954 (setq object (read (current-buffer)))
955 (error (error "Syntax error in raw text")))
956 (skip-chars-forward " \t\n")
957 ;; We should have swallowed all raw text.
959 (error "Syntax error in raw text (end of buffer)"))))
960 (djvu-process-text-bbox object 0 (make-vector 7 nil))
961 ;; Update read buffer
962 (djvu-init-read doc object)
963 ;; FIXME: Should we also update the text buffer?
964 ;; A transparent solution would update only the part of the buffer
965 ;; that we actually changed so that `undo' works as expected.
966 (djvu-decode-text object t)
968 (insert (format "select %d\nremove-txt\nset-txt\n" (djvu-doc-page doc)))
969 (djvu-insert-text object "")
971 (write-region nil nil script t 0))))
973 (defun djvu-process-text-bbox (object depth coords)
974 "Evaluate bounding box for text OBJECT recursively."
975 (if (stringp (nth 5 object))
976 (aset coords depth (vector (nth 1 object) (nth 2 object)
977 (nth 3 object) (nth 4 object)))
978 (let ((depth1 (1+ depth))
980 (aset coords depth nil)
981 (dolist (elt (nthcdr 5 object))
982 (djvu-process-text-bbox elt depth1 coords)
983 (if (setq coord (aref coords depth))
984 (let ((coord1 (aref coords depth1)))
985 (aset coord 0 (min (aref coord 0) (aref coord1 0)))
986 (aset coord 1 (min (aref coord 1) (aref coord1 1)))
987 (aset coord 2 (max (aref coord 2) (aref coord1 2)))
988 (aset coord 3 (max (aref coord 3) (aref coord1 3))))
989 (aset coords depth (copy-sequence (aref coords depth1)))))
990 (if (setq coord (aref coords depth))
991 (setcdr object (apply 'list (aref coord 0) (aref coord 1)
992 (aref coord 2) (aref coord 3)
994 (error "No coords??")))))
996 (defun djvu-display-text-all ()
997 "Display text for all pages."
1000 (buf (get-buffer-create djvu-all-buffer)))
1001 ;; Put this in a separate buffer!
1002 (with-current-buffer buf
1003 (let (buffer-read-only)
1006 (djvu-djvused doc t "-e" "output-txt")
1007 (goto-char (point-min)))
1008 (set-buffer-modified-p nil)
1009 (setq buffer-read-only t))
1010 (switch-to-buffer buf)))
1012 (defun djvu-process-all ()
1013 "Process all pages. Use at your own risk. You get what you want."
1015 (let ((buf (get-buffer djvu-all-buffer))
1017 (unless buf (error "No buffer `%s'" buf))
1018 (unless djvu-doc (error "No Djvu doc"))
1021 (setq script (make-temp-file "djvu-el-"))
1022 (with-temp-file script (insert-buffer-substring buf))
1023 (djvu-djvused djvu-doc nil "-f" script "-s"))
1024 (djvu-delete-file script))))
1028 (defun djvu-init-read (doc object)
1029 (with-current-buffer (djvu-doc-read-buf doc)
1030 (let (buffer-read-only)
1032 (djvu-insert-read object))
1033 (set-buffer-modified-p nil)
1034 (setq buffer-read-only t)
1035 (goto-char (point-min))
1038 (defun djvu-insert-read (object)
1039 "Display text OBJECT."
1040 ;; This function is called recursively.
1041 (let ((opoint (point))
1042 (tail (nthcdr 5 object)))
1043 (if (stringp (car tail))
1044 (insert (decode-coding-string (car tail) 'utf-8))
1045 (let* ((obj (caar tail))
1046 (sep (cond ((eq 'line obj) "\n")
1047 ((eq 'word obj) "\s")
1048 ((eq 'char obj) nil)
1051 (while (setq elt (pop tail))
1052 (djvu-insert-read elt)
1053 (if (and sep tail (not (looking-back sep)))
1055 (put-text-property opoint (point) (car object)
1056 (vector (nth 1 object) (nth 2 object)
1057 (nth 3 object) (nth 4 object)))))
1059 (defun djvu-read-pos (&optional point)
1060 "Return Djvu position (x . y) of POINT in Djvu Read buffer."
1061 (with-current-buffer (djvu-doc-read-buf)
1062 ;; An empty djvu page gives us something like (page 0 0 0 0 "")
1063 (if (= (point-min) (point-max))
1064 ;; Take the center of an empty page
1065 (cons (/ (car (djvu-doc-pagesize)) 2)
1066 (/ (cdr (djvu-doc-pagesize)) 2))
1067 (unless point (setq point (point)))
1068 (djvu-mean-pos ; Return mean coordinates
1069 (or (get-text-property point 'word)
1070 (get-text-property (1- point) 'word)
1072 ;; Search backward because more often point is at the end
1073 ;; of region we operated on
1074 (1- (previous-single-property-change point 'word)) 'word))))))
1076 (defun djvu-mean-pos (reg)
1077 "For region REG return mean coordinates (x . y)."
1078 ;; This works both for REG being vectors and lists.
1079 (cons (/ (+ (elt reg 0) (elt reg 2)) 2)
1080 (/ (+ (elt reg 1) (elt reg 3)) 2)))
1082 (defun djvu-locate-pos (object pos)
1083 "Locate OBJECT at position POS in the text or annotation buffer.
1084 If found, return corresponding position. Otherwise, return nil."
1085 (goto-char (point-min))
1087 (let ((re (concat "\\<" (symbol-name object) "\\> +"
1088 (mapconcat 'identity
1089 (make-list 4 "\\([[:digit:]]+\\)") " +")
1092 (while (and (not done)
1093 (re-search-forward re nil t))
1094 (let ((x1 (string-to-number (match-string 1)))
1095 (x2 (string-to-number (match-string 3)))
1096 (y1 (string-to-number (match-string 2)))
1097 (y2 (string-to-number (match-string 4))))
1098 (setq done (and (<= x1 (car pos))
1101 (<= (cdr pos) y2)))))
1103 (goto-char (point-min)) nil))))
1105 (defsubst djvu-dist (width height)
1106 (+ (* width width) (* height height)))
1108 (defun djvu-locate-read-pos (pos)
1109 "Locate POS in Djvu Read buffer. Return corresponding position."
1110 (with-current-buffer (djvu-doc-read-buf)
1112 (goto-char (point-min))
1113 (let ((hpos (car pos)) (vpos (cdr pos))
1114 (good-dist (djvu-dist (car (djvu-doc-pagesize))
1115 (cdr (djvu-doc-pagesize))))
1116 (pnt (point-min)) (good-pnt (point-min))
1119 (when (setq word (get-text-property pnt 'word))
1120 (setq dist (djvu-dist (- (/ (+ (aref word 0) (aref word 2)) 2) hpos)
1121 (- (/ (+ (aref word 1) (aref word 3)) 2) vpos)))
1122 (if (< dist good-dist)
1123 (setq good-pnt pnt good-dist dist)))
1124 (setq pnt (next-single-property-change pnt 'word))))
1125 (goto-char good-pnt)))))
1127 ;;; Djvu Annotation mode
1129 (defun djvu-comment-interactive (&optional border backclr textclr pushpin)
1130 "Interactive spec for `djvu-comment' and friends."
1131 (let ((pos (djvu-read-pos))
1132 (pagesize (djvu-doc-pagesize))
1133 (color (djvu-interactive-color djvu-color-highlight)))
1134 (list "" (read-string (format "(%s) Text: " color))
1135 (list (car pos) (cdr pos)
1136 (+ (car pos) (/ (car pagesize) 2))
1137 (+ (cdr pos) (/ (cdr pagesize) 30)))
1140 (djvu-color-background color djvu-color-background
1144 (defsubst djvu-insert-color (key color)
1146 (format " (%s %s)" key
1147 (cond ((string-match "\\`#" color) color)
1148 ((cdr (assoc color djvu-color-alist)))
1149 (t (error "Color `%s' undefined" color))))
1152 (defun djvu-comment (url text rect &optional border backclr textclr pushpin)
1153 "Using URL and TEXT, highlight RECT.
1154 This defines a rect area for djvused."
1155 (interactive (djvu-comment-interactive))
1156 (with-current-buffer (djvu-doc-annot-buf)
1157 (goto-char (point-max))
1158 (let (print-escape-newlines)
1159 (insert (format "(maparea %S\n %S\n " url (djvu-fill text))
1160 (apply 'format "(text %d %d %d %d)" rect)
1161 (if border (format " (%s)" border) "")
1162 (djvu-insert-color "backclr" backclr)
1163 (djvu-insert-color "textclr" textclr)
1164 (if pushpin " (pushpin)" "")
1168 (defun djvu-comment-pushpin (url text rect
1169 &optional border backclr textclr pushpin)
1170 (interactive (djvu-comment-interactive nil nil nil t))
1171 (djvu-comment url text rect border backclr textclr pushpin))
1173 (defun djvu-himark (beg end url text &optional color opacity border)
1174 "Himark region between BEG and END.
1175 This highlights the region between BEG and END and creates a bookmark entry."
1177 (let ((region (djvu-interactive-region)))
1178 (list (car region) (cdr region) "" ""
1179 djvu-color-himark djvu-opacity 'none)))
1180 (djvu-highlight beg end url text color opacity border)
1181 (djvu-bookmark (buffer-substring-no-properties beg end) (djvu-doc-page)))
1183 (defun djvu-url (beg end url text &optional color opacity border)
1185 (let* ((region (djvu-interactive-region))
1186 (color (djvu-interactive-color djvu-color-url))
1187 (url (djvu-interactive-url color)))
1188 (list (car region) (cdr region) url "" color djvu-opacity 'xor)))
1189 (djvu-highlight beg end url text color opacity border))
1191 (defun djvu-highlight (beg end url text &optional color opacity border)
1192 "Highlight region between BEG and END, add annotation TEXT."
1194 (let ((region (djvu-interactive-region))
1195 (color (djvu-interactive-color djvu-color-highlight)))
1196 (list (car region) (cdr region) ""
1197 (read-string (format "(%s) Annotation: " color))
1198 color djvu-opacity 'none)))
1200 (unless (get-text-property beg 'word)
1201 (error "Start position `%s' not a word" beg))
1202 (unless (get-text-property (1- end) 'word)
1203 (error "End position `%s' not a word" end))
1204 (let ((words (djvu-region-count beg end 'word))
1205 (lines (djvu-region-count beg end 'line))
1206 (paras (djvu-region-count beg end 'para))
1207 (regions (djvu-region-count beg end 'region))
1208 (columns (djvu-region-count beg end 'column))
1210 (unless (and (>= 1 paras) (>= 1 regions) (>= 1 columns))
1211 (error "Region spans multiple paragraphs"))
1214 (setq coords (list (djvu-scan-coords beg end 'word)))
1217 (let ((c1 (djvu-scan-coords beg (djvu-property-end (1+ beg) 'line) 'word))
1218 (c2 (djvu-scan-coords (djvu-property-beg (1- end) 'line) end 'word)))
1219 ;; If BEG is beginning of first line, both lines share same left margin.
1220 (if (and (= beg (djvu-property-beg beg 'line))
1221 (djvu-coords-justify t c1 c2))
1222 (djvu-justify-coords 'min 0 c1 c2))
1223 ;; If END is end of second line, both lines share same right margin.
1224 (if (and (= end (djvu-property-end end 'line))
1225 (djvu-coords-justify nil c2 c1))
1226 (djvu-justify-coords 'max 2 c1 c2))
1227 (if (<= (aref c1 0) (aref c2 2))
1228 ;; Lower bound of upper box and upper bound of lower box coincide.
1229 (let ((tmp (/ (+ (aref c1 1) (aref c2 3)) 2)))
1230 (aset c1 1 tmp) (aset c2 3 tmp)))
1231 (setq coords (list c1 c2)))
1233 (let* ((l1e (djvu-property-end (1+ beg) 'line))
1234 (l2b (djvu-property-beg (1- end) 'line))
1235 (c1 (djvu-scan-coords beg l1e 'word))
1236 (ci (djvu-scan-coords (1+ l1e) (1- l2b) 'line))
1237 (c2 (djvu-scan-coords l2b end 'word)))
1238 ;; If BEG is beginning of first line, all lines share same left margin.
1239 (cond ((and (= beg (djvu-property-beg beg 'line))
1240 (djvu-coords-justify t c1 ci c2))
1241 (djvu-justify-coords 'min 0 c1 ci c2))
1242 ((djvu-coords-justify t ci c2)
1243 (djvu-justify-coords 'min 0 ci c2)))
1244 ;; If END is end of last line, all lines share same right margin.
1245 (cond ((and (= end (djvu-property-end end 'line))
1246 (djvu-coords-justify nil c2 ci c1))
1247 (djvu-justify-coords 'max 2 c1 ci c2))
1248 ((djvu-coords-justify nil c1 ci)
1249 (djvu-justify-coords 'max 2 c1 ci)))
1250 (let ((tmp1 (/ (+ (aref c1 1) (aref ci 3)) 2))
1251 (tmp2 (/ (+ (aref ci 1) (aref c2 3)) 2)))
1252 ;; Lower bound of upper boxes and upper bound of lower boxes coincide.
1253 (aset c1 1 tmp1) (aset ci 3 tmp1)
1254 (aset ci 1 tmp2) (aset c2 3 tmp2))
1255 (setq coords (list c1 ci c2)))))
1257 (djvu-highlight-region url text coords color opacity border)))
1259 (defun djvu-highlight-region (url text coords &optional color opacity border)
1260 "Using URL and TEXT, highlight COORDS.
1261 This defines a hilite area for djvused."
1262 ;; Record position where annotation was made.
1263 (let ((posl (mapcar 'djvu-mean-pos coords))
1264 (n (length coords)))
1265 (djvu-doc-set-pos (cons (/ (apply '+ (mapcar 'car posl)) n)
1266 (/ (apply '+ (mapcar 'cdr posl)) n))))
1267 ;; Insert in Annotations buffer.
1268 (with-current-buffer (djvu-doc-annot-buf)
1269 (goto-char (point-max))
1270 (let (print-escape-newlines)
1271 (insert (format "(maparea %S\n %S\n (" url (djvu-fill text))
1273 (lambda (rect) (apply 'format "(rect %d %d %d %d)" (append rect nil)))
1275 (djvu-insert-color "hilite" color)
1276 (if opacity (format " (opacity %s)" opacity) "")
1277 (if border (format " (%s)" border) "")
1281 (defun djvu-fill (text)
1282 "Fill string TEXT using `djvu-fill-column'."
1283 (if djvu-fill-column
1286 (let ((fill-column djvu-fill-column))
1287 (fill-region (point-min) (point-max)))
1288 (buffer-substring-no-properties
1289 (point-min) (point-max)))
1292 (defun djvu-property-beg (pnt prop)
1293 ;; Assume that PNT has PROP. Otherwise we would not know whether
1294 ;; to search for it before or after PNT.
1295 (let ((p1 (get-text-property pnt prop)))
1296 (unless p1 (error "Position %s does not have property %s" pnt prop))
1297 (if (> pnt (point-min))
1298 (let ((p0 (get-text-property (1- pnt) prop)))
1300 (setq pnt (previous-single-property-change
1301 pnt prop nil (point-min))))))
1304 (defun djvu-property-end (pnt prop)
1305 ;; Assume that (1- PNT) has PROP. Otherwise we would not know whether
1306 ;; to search for it before or after PNT.
1307 (let ((p1 (get-text-property (1- pnt) prop)))
1308 (unless p1 (error "Position %s does not have property %s" pnt prop))
1309 (if (< pnt (point-max))
1310 (let ((p0 (get-text-property pnt prop)))
1312 (setq pnt (next-single-property-change
1313 (1- pnt) prop nil (point-max))))))
1316 (defun djvu-coords-justify (left &rest ci)
1317 "Return non-nil if rect coordinates CI shall be justified horizontally.
1318 If LEFT is nil analyze left boundaries of CI, otherwise the right boundaries."
1319 (let ((xl (apply 'min (mapcar (lambda (c) (aref c 0)) ci)))
1320 (xr (apply 'max (mapcar (lambda (c) (aref c 2)) ci))))
1321 (> djvu-coords-justify
1322 (/ (apply 'max (mapcar (lambda (cj)
1323 (abs (float (if left (- (aref cj 0) xl)
1324 (- xr (aref cj 2))))))
1326 (float (- xr xl))))))
1328 (defun djvu-justify-coords (fun n &rest ci)
1329 "Pass Nth elements of arrays CI to function FUN.
1330 Set these elements to return value of FUN.
1331 If FUN is `min' or `max' these elements are set to the respective minimum
1332 or maximum among the Nth elements of all arrays CI."
1333 (let ((tmp (apply fun (mapcar (lambda (c) (aref c n)) ci))))
1337 (defun djvu-scan-coords (beg end prop)
1338 "Between BEG and END calculate total bounding box for PROP."
1339 ;; Assume that BEG has PROP.
1340 (let ((coords (copy-sequence (get-text-property beg prop)))
1342 (while (and (/= pnt end)
1343 (setq pnt (next-single-property-change pnt prop nil end)))
1344 (when (setq val (get-text-property pnt prop))
1345 (aset coords 0 (min (aref coords 0) (aref val 0)))
1346 (aset coords 1 (min (aref coords 1) (aref val 1)))
1347 (aset coords 2 (max (aref coords 2) (aref val 2)))
1348 (aset coords 3 (max (aref coords 3) (aref val 3)))))
1351 (defun djvu-region-count (beg end prop)
1352 "Count regions between BEG and END with distinct non-nil values of PROP."
1355 (while (and (/= pnt end)
1356 (setq pnt (next-single-property-change pnt prop nil end)))
1357 (if (get-text-property (1- pnt) prop)
1358 (setq count (1+ count))))
1361 (defun djvu-process-annot (script &optional doc)
1362 (let ((doc djvu-doc) object)
1364 (insert-buffer-substring (djvu-doc-annot-buf doc))
1366 (goto-char (point-min))
1367 (while (progn (skip-chars-forward " \t\n") (not (eobp)))
1368 (if (looking-at "(\\(background\\|zoom\\|mode\\|align\\|maparea\\|metadata\\)\\>")
1370 (push (read (current-buffer)) object)
1371 (error (error "Syntax error in annotations")))
1372 (error "Unknown annotation `%s'" (buffer-substring-no-properties
1373 (point) (line-end-position))))))
1374 (setq object (nreverse object))
1375 (dolist (elt object)
1376 (when (eq 'maparea (car elt))
1378 (setcar (cdr elt) (encode-coding-string (djvu-resolve-url (nth 1 elt)) 'utf-8))
1380 (setcar (nthcdr 2 elt) (encode-coding-string (nth 2 elt) 'utf-8))))
1383 (let ((standard-output (current-buffer))
1384 (print-escape-newlines t)
1386 (insert (format "select %d\nremove-ant\nset-ant\n"
1387 (djvu-doc-page doc)))
1388 (dolist (elt object)
1389 (cond ((not (eq 'maparea (car elt)))
1392 ((consp (car (nth 3 elt))) ; rect
1393 (dolist (e (nth 3 elt))
1394 (insert (prin1-to-string
1395 (apply 'list (car elt) (nth 1 elt) (nth 2 elt)
1396 (djvu-rect e t) (nthcdr 4 elt))) "\n")))
1397 ((eq 'text (car (nth 3 elt))) ; text
1398 (insert (prin1-to-string
1399 (apply 'list (car elt) (nth 1 elt) (nth 2 elt)
1400 (djvu-rect (nth 3 elt) t)
1401 (nthcdr 4 elt))) "\n"))
1402 (t (error "Djvu maparea %s undefined" (car (nth 3 elt))))))
1405 (write-region nil nil script t 0))))
1407 (defun djvu-display-annot-all (&optional display)
1408 "Print annotations for all pages."
1409 (interactive (list t))
1410 (let ((doc djvu-doc)
1411 (buf (get-buffer-create djvu-all-buffer)))
1412 ;; Put this in a separate buffer!
1413 (with-current-buffer buf
1414 (let (buffer-read-only)
1417 (djvu-djvused doc t "-e" "output-ant")
1418 (goto-char (point-min))
1419 (while (re-search-forward "^(maparea" nil t)
1420 (forward-sexp) ; jump over URL
1421 ;; replace newlines within text
1422 (let ((limit (save-excursion (forward-sexp) (point))))
1423 (while (search-forward "\\n" limit t)
1424 (replace-match "\n"))))
1425 (goto-char (point-min)))
1426 (set-buffer-modified-p nil)
1427 (setq buffer-undo-list nil))
1428 (if display (switch-to-buffer buf))))
1430 ;;; Djvu Outline mode
1432 (defun djvu-bookmark (text page)
1435 (let ((region (djvu-interactive-region)))
1436 (list (read-string "Bookmark: " (buffer-substring-no-properties
1437 (car region) (cdr region)))
1439 ;; Remove newlines that are ignored anyway
1440 (setq text (replace-regexp-in-string "\n" " " text))
1442 (with-current-buffer (djvu-doc-outline-buf)
1443 (goto-char (point-min))
1444 (if (equal (point) (point-max))
1445 (setq object (list 'bookmarks))
1447 (setq object (read (current-buffer)))
1448 (error (error "Syntax error in outline"))))
1449 (unless (eq 'bookmarks (car object))
1450 (error "No bookmarks"))
1451 ;; No decoding/encoding necessary if we add another bookmark.
1452 (setcdr object (sort (append (cdr object)
1453 (list (list text (format "#%d" page))))
1455 (< (string-to-number (substring (nth 1 x) 1))
1456 (string-to-number (substring (nth 1 y) 1))))))
1458 (insert "(bookmarks")
1459 (let (print-escape-newlines)
1460 (djvu-insert-outline (cdr object) " "))
1462 (goto-char (point-min))
1465 (defun djvu-decode-outline (object &optional encode)
1466 "Decode Djvu Outline OBJECT. Encode if ENCODE is non-nil."
1467 (dolist (elt object)
1471 (encode-coding-string (car elt) 'utf-8)
1472 (decode-coding-string (car elt) 'utf-8)))
1477 (encode-coding-string (cadr elt) 'utf-8)
1478 (decode-coding-string (cadr elt) 'utf-8))))
1479 ;; Continue with subtree.
1480 (djvu-decode-outline (nthcdr 2 elt) encode)))
1482 (defun djvu-insert-outline (object indent)
1483 "Insert Outline OBJECT."
1484 ;; This function is called recursively.
1485 (let ((indent1 (concat indent " ")))
1486 (dolist (elt object)
1487 (insert (format "\n%s(%S\n%s %S" indent (car elt) indent (nth 1 elt)))
1488 (djvu-insert-outline (nthcdr 2 elt) indent1)
1491 (defun djvu-process-outline (script &optional doc)
1493 (with-current-buffer (djvu-doc-outline-buf doc)
1495 (goto-char (point-min))
1496 (unless (= (point-min) (point-max))
1498 (setq object (read (current-buffer)))
1499 (error (error "Syntax error in outline"))))
1500 (skip-chars-forward " \t\n")
1501 ;; We should have swallowed all bookmarks.
1503 (error "Syntax error in outline (end of buffer)"))))
1504 (unless (eq 'bookmarks (car object))
1505 (error "No bookmarks"))
1506 (djvu-decode-outline (cdr object) t)
1508 (insert "set-outline\n")
1510 (insert "(bookmarks")
1511 (let ((print-escape-newlines t))
1512 (djvu-insert-outline (cdr object) " "))
1515 (write-region nil nil script t 0))))
1517 ;;; Image minor mode
1519 (define-minor-mode djvu-image-mode
1520 "Toggle image display of current page."
1522 :keymap '(([drag-mouse-1] . djvu-mouse-comment)
1523 ([C-drag-mouse-1] . djvu-mouse-comment-pushpin)
1524 ([S-drag-mouse-1] . djvu-mouse-highlight)
1525 ;; (Global) bindings of down-mouse events would take precedence over
1526 ;; drag-mouse events. So we bind the down-mouse events to `ignore'.
1527 ([down-mouse-1] . ignore)
1528 ([C-down-mouse-1] . ignore)
1529 ([S-down-mouse-1] . ignore)
1530 ("+" . djvu-image-zoom-in)
1531 ("-" . djvu-image-zoom-out))
1534 (defun djvu-image-zoom-in ()
1536 (djvu-image (round (* (nth 1 (djvu-doc-image)) 1.2))))
1538 (defun djvu-image-zoom-out ()
1540 (djvu-image (round (/ (nth 1 (djvu-doc-image)) 1.2))))
1542 (defun djvu-image (&optional isize)
1543 "If `djvu-image-mode' is enabled, display image of current Djvu page.
1544 Otherwise remove the image."
1545 (if (not djvu-image-mode)
1546 (let (buffer-read-only)
1547 (remove-text-properties (point-min) (point-max) '(display nil)))
1548 ;; Update image if necessary.
1549 (if (or (not (eq (djvu-doc-page) (car (djvu-doc-image))))
1551 (not (eq isize (nth 1 (djvu-doc-image))))))
1552 (let ((file (make-temp-file "djvu-"))
1554 (nth 1 (djvu-doc-image))
1557 ;; ddjvu does not send tiff files to stdout
1558 (let ((doc djvu-doc)
1559 (status (call-process "ddjvu" nil t nil
1560 (format "-size=%dx%d" isize isize)
1562 (format "-page=%d" (djvu-doc-page))
1565 (unless (zerop status)
1566 (error "Ddjvu error %s" status))
1568 (set-buffer-multibyte nil)
1569 (insert-file-contents-literally file)
1571 (list (djvu-doc-page doc)
1573 (create-image (buffer-substring-no-properties
1574 (point-min) (point-max))
1576 (djvu-delete-file file))))
1578 (let (buffer-read-only)
1579 (put-text-property (point-min) (point-max)
1580 'display (nth 2 (djvu-doc-image))))))
1582 (defun djvu-event-to-rect (event)
1583 "Convert mouse EVENT to Djvu rect coordinates."
1584 (let* ((start (posn-object-x-y (event-start event)))
1585 (end (posn-object-x-y (event-end event)))
1586 (x1 (car start)) (y1 (cdr start)) (x2 (car end)) (y2 (cdr end))
1587 (size (posn-object-width-height (event-start event)))
1588 (width (/ (float (car (djvu-doc-pagesize))) (car size)))
1589 (height (/ (float (cdr (djvu-doc-pagesize))) (cdr size))))
1590 (list (round (* (min x1 x2) width))
1591 (round (* (- (cdr size) (max y1 y2)) height))
1592 (round (* (max x1 x2) width))
1593 (round (* (- (cdr size) (min y1 y2)) height)))))
1595 (defun djvu-mouse-highlight (event)
1597 ;; Mouse events ignore prefix args?
1598 (let ((color (djvu-interactive-color djvu-color-highlight)))
1599 (djvu-highlight-region "" (read-string (format "(%s) H-Text: " color))
1600 (list (djvu-event-to-rect event))
1601 color djvu-opacity)))
1603 (defun djvu-mouse-comment (event &optional pushpin)
1605 ;; Mouse events ignore prefix args?
1606 (let ((color (djvu-interactive-color djvu-color-highlight)))
1607 (djvu-comment "" (read-string (format "(%s) C-Text: " color))
1608 (djvu-event-to-rect event) nil
1609 (djvu-color-background color djvu-color-background
1613 (defun djvu-mouse-comment-pushpin (event)
1615 (djvu-mouse-comment event t))
1619 (defun djvu-make-clean ()
1620 "Remove Outline and Annotations."
1622 (when (yes-or-no-p "Remove Outline and Annotations ")
1623 (djvu-djvused djvu-doc nil "-e"
1624 "select; remove-ant; set-outline;\n." "-s")
1629 ;;; djvu.el ends here