;;; djvu.el --- Edit and view Djvu files via djvused -*- lexical-binding: t -*-

;; Copyright (C) 2011-2022  Free Software Foundation, Inc.

;; Author: Roland Winkler <winkler@gnu.org>
;; Keywords: files, wp
;; Version: 1.1.2

;; This program 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.

;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This package is a front end for the command-line program djvused
;; from DjVuLibre, see http://djvu.sourceforge.net/.  It assumes you
;; have the programs djvused, djview, ddjvu, and djvm installed.
;; The main purpose of djvu.el is to edit Djvu documents via djvused.
;; If you only seek an Emacs viewer for Djvu documents, you may be
;; better off with DocView shipped with GNU Emacs.  Starting from
;; GNU Emacs 26, DocView supports Djvu documents.
;;
;; A Djvu document contains an image layer (typically scanned page images)
;; as well as multiple textual layers [text (for scanned documents from OCR),
;; annotations, shared annotations, and bookmarks].  The command-line
;; program djvused allows one to edit these textual layers via suitable
;; scripts.  With Djvu mode you can edit and apply these djvused scripts
;; as if you were directly editing the textual layers of a Djvu document
;; (though Emacs never visits the Djvu document in the usual Emacs sense
;; of copying the content of a file into a buffer to manipulate it).
;; With Djvu mode you can also view the page images of a Djvu document,
;; yet Djvu mode does not attempt to reinvent the functionality of the
;; native viewer djview for Djvu documents.  (I find djview very efficient
;; / fast for its purposes that also include features like searching the
;; text layer.)  So Djvu mode supports that you use djview to view the
;; Djvu document while editing its textual layers.  Djview and Djvu mode
;; complement each other.
;;
;; A normal work flow is as follows:
;;
;; Djvu files are assumed to have the file extension ".djvu".
;; When you visit the file foo.djvu, it puts you into the (read-only)
;; buffer foo.djvu.  Normally, this buffer (plus possibly the outline buffer)
;; is all you need.
;;
;; The menu bar of this buffer lists most of the commands with their
;; respective key bindings.  For example, you can:
;;
;; - Use `g' to go to the page you want.  (Yes, Djvu mode operates on one
;;   page at a time.  Anything else would be too slow for large documents.)
;;
;; - Use `v' to (re)start djview using the position in the file foo.djvu
;;   matching where point is in the buffer foo.djvu.  (I find djview
;;   fast enough for this, even for larger documents.)
;;
;;   Yet note also that, starting from its version 4.9, djview reloads
;;   djvu documents automatically when the djvu file changed on disk.
;;   So you need not restart it anymore while editing a Djvu document
;;   with Djvu mode.  (Thank you, Leon Bottou!)
;;
;;   Djvu mode likewise detects when the file changed on disk
;;   (say, because the file was modified by some other application),
;;   so that you can revert the buffers visiting this file.
;;
;; - To highlight a region in foo.djvu mark the corresponding region
;;   in the buffer foo.djvu (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.  View your changes with
;;   djview.
;;
;; - Type `i' to enable `djvu-image-mode', a minor mode displaying the
;;   current page as an image.  Then
;;     drag-mouse-1 defines a rect area
;;     S-drag-mouse-1 defines an area where to put a text area,
;;     C-drag-mouse-1 defines an area where to put a text area w/pushpin.
;;
;; - Use `o' to switch to the buffer foo.djvu-o displaying the outline
;;   of the document (provided the document contains bookmarks that you
;;   can add with Djvu mode).  You can move through a multi-page document
;;   by selecting a bookmark in the outline buffer.
;;
;; - The editing of the text, annotation, shared annotation and outline
;;   (bookmarks) layers really happens in the buffers foo.djvu-t,
;;   foo.djvu-a, foo-djvu-s, and foo.djvu-b.  The djvused script syntax
;;   used in these buffers is so close to Lisp that it was natural to give
;;   these buffers a `djvu-script-mode' that is derived from `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 the main buffer foo.djvu.
;;
;;   In these buffers, the menu bar lists a few low-level commands
;;   available for editing these buffers directly.  If you know the
;;   djvused script syntax, sometimes it can also be helpful to do
;;   such editing "by hand".
;;
;; But wait: the syntax in the annotations buffer foo.djvu-a is a
;; slightly modified djvused script syntax.
;;
;; - djvused can only highlight rectangles.  So the highlighting of
;;   larger areas of text must use multiple rectangles (i.e.,
;;   multiple djvused "mapareas").  To make editing easier, these
;;   are combined in the buffer foo.djvu-a.  (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!
;;
;; - djvused uses two different ways of specifying coordinates for
;;   rectangles
;;     (1) hidden text uses quadrupels (xmin ymin xmax ymax)
;;     (2) maparea annotations use (xmin ymin width height)
;;   Djvu mode always uses quadrupels (xmin ymin xmax ymax)
;;   Thus maparea coordinates are converted from and to djvused's format
;;   when reading and writing djvu files.
;;
;; - Usually Djvu mode operates on the text and annotations layers
;;   for one page of a Djvu document.  If you really (I mean: REALLY)
;;   want to edit a raw djvused script for the complete text or
;;   annotations layer of a djvu document, use `djvu-text-script' or
;;   `djvu-annot-script' to generate these raw scripts.  When you have
;;   finished editing, you can re-apply the script by calling
;;   `djvu-process-script'.  Use this at your own risk.  This code does
;;   not check whether the raw script is meaningful.  You can loose the
;;   text or annotations layer if the script is messed up.

;;; News:

;; v1.1.2:
;; - Support changing the mode of a buffer visiting a Djvu document.
;;
;; - Support `doc-view-toggle-display' with `major-mode-suspend'.
;;
;; - Selecting the background color "transparent" removes the
;;   background color attribute.
;;
;; - New options `djvu-image-zoom' and `djvu-ascenders-re'.
;;
;; - Bug fixes.
;;
;; v1.1.1:
;; - Support text and image scrolling similar to `doc-view-mode'.
;;   New option `djvu-continuous'.
;;
;; - New option `djvu-descenders-re'.
;;
;; - Bug fixes.
;;
;; v1.1:
;; - Use `auto-mode-alist' with file extension ".djvu".
;;
;; - Support bookmarks.
;;
;; - Display total number of pages in mode line.
;;
;; - New option `djvu-rect-area-nodups'.
;;
;; - User options `djvu-save-after-edit' and `djvu-region-history' removed
;;   (obsolete).
;;
;; - More robust code for merging lines in text layer.
;;
;; - Clean up handling of editing positions in a djvu document.
;;
;; - Bug fixes.
;;
;; v1.0.1:
;; - Use `create-file-buffer' instead of `generate-new-buffer'
;;   for compatibility with uniquify.
;;
;; v1.0:
;; - New commands `djvu-revert-buffer', `djvu-re-search-forward',
;;   `djvu-re-search-forward-continue', `djvu-history-backward',
;;   `djvu-history-forward', `djvu-dpi', `djvu-dpi-unify', `djvu-rotate',
;;   `djvu-page-title', `djvu-ls', `djvu-inspect-file', `djvu-delete-page',
;;   and `djvu-remove-annot'.
;;
;; - New commands for editing the text layer `djvu-edit-word',
;;   `djvu-split-word', `djvu-merge-words', and `djvu-merge-lines'.
;;
;; - Make backups when editing Djvu documents.
;;
;; - Pretty-printed outline buffer for bookmarks.
;;
;; - Shared annotations buffer.
;;
;; - Font locking.

;;; To do:

;; - Auto-save script buffers.  How can we recover these buffers
;;   in a meaningful way?
;;
;; - Use `replace-buffer-contents'?
;;
;; - New command that makes line breaks in text layer better searchable:
;;   Scan text layer for lines ending with hyphenated words "xxx-".
;;   If the first word of the next line is "yyy" and ispell knows
;;   the word "xxxyyy", replace "yyy" with that string.  A search
;;   for the word "xxxyyy" will then succeed.

;;; Code:

;;; Djvu internals (see Sec. 8.3.4.2.3.1 of djvu3spec.djvu)
;;
;; Supported area attributes             rect  text  oval  line  poly
;; (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..200 (yes)
;;
;; zones: page, column, region, para, line, word, and char
;; areas: rect, text, oval, line, and poly

(require 'image-mode)
(eval-when-compile
  (require 'cl-lib))

(defgroup djvu nil
  "Djvu mode."
  :group 'wp
  :prefix "djvu-")

(defcustom djvu-color-highlight "yellow"
  "Default color for highlighting."
  :group 'djvu
  :type 'string)

(defcustom djvu-color-himark "red"
  "Default color for highmarking."
  :group 'djvu
  :type 'string)

(defcustom djvu-color-url "blue"
  "Default color for URLs."
  :group 'djvu
  :type 'string)

(defcustom djvu-color-background "white"
  "Default background."
  :group 'djvu
  :type 'string)

(defcustom djvu-color-line "black"
  "Default line color."
  :group 'djvu
  :type 'string)

(defcustom djvu-color-alist
  ;; If the keys are strings, they are directly compatible with what
  ;; we get back from something like `completing-read'.
  '(("red"     . "#FF0070") ; 0
    ("green"   . "#00FF00") ; 1
    ("blue"    . "#6666FF") ; 2
    ("yellow"  . "#EEFF00") ; 3
    ("orange"  . "#FF7F00") ; 4
    ("magenta" . "#FF00FF") ; 5
    ("purple"  . "#7F60FF") ; 6
    ("cyan"    . "#00FFFF") ; 7
    ("pink"    . "#FF6060") ; 8
    ("white"   . "#FFFFFF") ; 9
    ("black"   . "#000000")); 10
  "Alist of colors for highlighting."
  :group 'djvu
  :type '(repeat (cons (string) (string))))

(defcustom djvu-line-width 1
  "Default line width."
  :group 'djvu
  :type 'integer)

(defcustom djvu-opacity 50
  "Default opacity for Highlighting."
  :group 'djvu
  :type 'integer)

(defcustom djvu-areas-justify 0.02
  "Upper threshold for justifying area coordinates."
  :group 'djvu
  :type 'number)

(defcustom djvu-fill-column 50
  "Fill column for Djvu annotations."
  :group 'djvu
  :type 'integer)

(defcustom djvu-script-buffer "*djvu*"
  "Default buffer for \"raw\" djvused scripts."
  :group 'djvu
  :type 'string)

(defcustom djvu-buffer-name-extensions
  '("" "-t" "-a" "-s" "-b" "-o")
  "Extensions for Djvu buffer names.
This is a list with six elements (READ TEXT ANNOT SHARED BOOKMARKS OUTLINE)."
  :group 'djvu
  :type '(list (string) (string) (string) (string) (string) (string)))

(defcustom djvu-image-size 1024
  "Size of internally displayed image.  This is MAX (width, height)."
  :group 'djvu
  :type 'integer)

(defcustom djvu-inherit-input-method t
  "If non-nil calls of `read-string' inherit the input method."
  :group 'djvu
  :type 'boolean)

(defcustom djvu-djview-command "djview"
  "Command for the Djvu Viewer."
  :group 'djvu
  :type 'string)

(defcustom djvu-djview-options nil
  "List of command options for the Djvu Viewer."
  :group 'djvu
  :type '(repeat (string)))

(defcustom djvu-file-name-extension-re (regexp-opt '(".djvu" ".djbz" ".iff"))
  "Regular expression for file name extensions in bundled multi-page documents.
These extensions include the period."
  :group 'djvu
  :type 'regexp)

(defcustom djvu-read-prop-newline 2
  "Number of newline characters in Read buffer for consecutive region."
  :group 'djvu
  :type 'integer)

(defcustom djvu-outline-faces
  ;; Same as `outline-font-lock-faces'
  [font-lock-function-name-face font-lock-variable-name-face
  font-lock-keyword-face font-lock-comment-face
  font-lock-type-face font-lock-constant-face
  font-lock-builtin-face font-lock-string-face]
  "Vector of faces for Outline buffer."
  :group 'djvu
  :type '(sexp))

(defcustom djvu-string-replace-list
  '(("-\n+\\([[:lower:]]\\)" . "\\1") ; hyphenation
    ("-\n+" . "-") ; hyphenation
    ("[\n ]+" . " ")) ; white space
  "Replacement list for text strings.
Each element is of the form (REGEXP . REP).
Used by `djvu-region-string'."
  :group 'djvu
  :type '(repeat (cons (regexp) (string))))

(defcustom djvu-rect-area-nodups nil
  "If non-nil `djvu-rect-area' does not create multiple rects for same areas."
  :group 'djvu
  :type 'boolean)

(defcustom djvu-continuous nil
  "When non-nil, scrolling to the page edge advances to next/previous page."
  :group 'djvu
  :type 'boolean)

(defcustom djvu-image-zoom 1.2
  "Zoom factor for images."
  :group 'djvu
  :type 'number)

(defcustom djvu-descenders-re "[(),;Qgjpqy]" ; some fonts also `J' and `f'
  ;; https://en.wikipedia.org/wiki/Descender
  "Regexp matching any descending characters or nil.
With Djvu mode, mapareas of annotations match tight the text they refer to.
This may appear visually awkward if the lower bound of the maparea lines up
with the baseline of the text because the text contains no descenders
from characters such as `g' or `q'.  Then, if the text does not match
the regexp `djvu-descenders-re', the annotation area will descend
slightly below the baseline."
  :group 'djvu
  :type '(choice regexp (const nil)))

(defcustom djvu-ascenders-re "[^-,.;:acegm-su-z\s]"
  "Regexp matching ascending characters or nil, see `djvu-descenders-re'."
  :group 'djvu
  :type '(choice regexp (const nil)))

;; Internal variables

(defvar djvu-coords-re
  (format "\\(?2:%s\\)"
          (mapconcat (lambda (i) (format "\\(?%d:-?[0-9]+\\)" i))
                     '(3 4 5 6) "[\s\t]+"))
  "Regexp matching the coordinates of Djvu areas and zones.
Substring 2: coordinates, 3-6: individual coordinates.")

(defvar djvu-coord-xy-re
  (mapconcat (lambda (i) (format "\\(?%d:-?[0-9]+\\)" i))
             '(1 2) "[\s\t]+")
  "Regexp matching pair of xy coordinates of Djvu maparea poly.
Substrings 1-2: individual coordinates.")

(defvar djvu-area-re
  (format "(\\(?1:%s\\)[\s\t]+%s[)\s\t\n]"
          (regexp-opt '("rect" "oval" "text" "line" "poly"))
          djvu-coords-re)
  "Regexp matching a Djvu area.
Substring 1: area type, 2: coordinates, 3-6: individual coordinates.")

(defvar djvu-zone-re
  (format "[\s\t]*(\\(?1:%s\\)[\s\t]+%s[\s\t\n]+" ; omit closing `)'
          (regexp-opt '("page" "column" "region" "para" "line"
                        "word" "char"))
           djvu-coords-re)
  "Regexp matching the beginning of a Djvu text zone.
Substring 1: zone type, 2: coordinates, 3-6: individual coordinates.")

(defvar djvu-test nil
  "If non-nil do not process / delete djvused scripts.  Useful for testing.")
;; (setq djvu-test t) (setq djvu-test nil)

(defvar-local djvu-buffer nil
  "Type of Djvu buffer.")

(defvar djvu-rect-list nil
  "Expanded rect list for propertizing the Read buffer.
This is a list with elements (COORDS URL TEXT COLOR ID) stored
in `djvu-doc-rect-list'.")

(defvar djvu-last-rect nil
  "Last rect used for propertizing the Read buffer.
This is a list (BEG END COORDS URL TEXT COLOR).")

;; We use variable `djvu-resolve-url' as an internal flag while we update
;; all internal URLs in a Djvu document via `djvu-resolve-all-urls'.
;; Then we use `djvu-doc-resolve-url' to remember this scheme
;; and for adding new internal URLs consistent with this scheme.
(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.
Bind this with `let' to select one of these schemes.")

(defvar djvu-bookmark-level nil
  "Counter for bookmark level.")

(defvar djvu-image-mode) ; fully defined by `define-minor-mode' (buffer-local)

(defvar djvu-init nil
  "Non-nil during initialization of Djview mode.")

(defvar djvu-color-attributes '(border hilite lineclr backclr textclr)
  "List of color attributes known to Djvu.  See djvused(1).")

(defvar djvu-color-re
  (concat "(" (regexp-opt (mapcar #'symbol-name djvu-color-attributes) t)
          "[ \t\n]+\\(%s\\(%s[[:xdigit:]][[:xdigit:]]"
          "[[:xdigit:]][[:xdigit:]][[:xdigit:]][[:xdigit:]]\\)%s\\)[ \t\n]*)")
  "Format string to create a regular expression matching color attributes.")

(defvar djvu-beg-object-re
  (concat "^[\s\t]*(" (regexp-opt '("background" "zoom" "mode" "align"
                                    "maparea" "metadata" "xmp" "bookmarks")
                                  t)
          "\\>")
  "Regexp matching the beginning of a Djvu object.  See djvused(1).")

(defvar djvu-last-search-re nil
  "Last regexp used by `djvu-re-search-forward'.")

(defvar djvu-modified nil
  "Let-bound in `djvu-mouse-drag-track-area'.")

;; See `ediff-defvar-local'
(defmacro djvu-defvar-local (var &optional val doc)
  "Define VAR as a permanent-local variable, and return VAR."
  (declare (doc-string 3))
  `(progn
     (defvar ,var ,val ,doc)
     (make-variable-buffer-local ',var)
     (put ',var 'permanent-local t)
     ,var))

(djvu-defvar-local djvu-doc nil
  "The \"ID\" of a Djvu document.
This is actually the Read buffer acting as the master buffer
of the Djvu document.  This buffer holds all buffer-local values
of variables for a Djvu document.")

;; permanent-local like `buffer-file-name'
(djvu-defvar-local djvu-doc-file nil
  "File name of a Djvu document.")

(djvu-defvar-local djvu-doc-text-buf nil
  "Text buffer of a Djvu document.")

;; "read" refers to the text-only display of djvu files inside emacs
;; "view" refers to external graphical viewers (default djview)

(djvu-defvar-local djvu-doc-read-buf nil
  "Read buffer of a Djvu document.")

(djvu-defvar-local djvu-doc-annot-buf nil
  "Annotation buffer of a Djvu document.")

(djvu-defvar-local djvu-doc-shared-buf nil
  "Shared annotation buffer of a Djvu document.")

(djvu-defvar-local djvu-doc-bookmarks-buf nil
  "Bookmarks buffer of a Djvu document.")

(djvu-defvar-local djvu-doc-outline-buf nil
  "Outline buffer of a Djvu document.")

(djvu-defvar-local djvu-doc-view-proc nil
  "List of djview processes for a Djvu document.")

(defvar-local djvu-doc-resolve-url nil
  "Resolve URLs of a Djvu document.")

(defvar-local djvu-doc-rect-list nil
  "Rect list of a Djvu document.")

(defvar-local djvu-doc-history-backward nil
  "Backward history of a Djvu document.
This is a stack of pages visited previously.")

(defvar-local djvu-doc-history-forward nil
  "Forward history of a Djvu document.")

(defvar-local djvu-doc-page nil
  "Current page number of a Djvu document.")

(defvar-local djvu-doc-pagemax nil
  "Total number of pages of a Djvu document.")

(defvar-local djvu-doc-page-id nil
  "Alist of page IDs of a Djvu document.
Each element is a cons pair (PAGE-NUM . FILE-ID).")

(defvar-local djvu-doc-pagesize nil
  "Size of current page of a Djvu document.")

(defvar-local djvu-doc-read-pos nil
  "The current editing position in the Read buffer (image coordinates).
This is either a list (X Y) or a list or vector (XMIN YMIN XMAX YMAX).
Used in `djvu-image-mode' when we cannot go to this position.")

(defvar-local djvu-doc-image nil
  "Image of current page of a Djvu document.
This is a list (PAGE-NUM MAGNIFICATION IMAGE).")

(defvar-local djvu-doc-image-hscroll 0
  "Number of columns by which a page image is scrolled from left margin.")

(defvar-local djvu-doc-image-vscroll 0
  "Amount by which a page image is scrolled vertically.")

;;; Helper functions and macros

;; For each Djvu document we have six buffers associated with this document
;; (read, text, annotations, shared annotations, bookmarks and outline buffers).
;; To have document-local variables, `djvu-doc' defines a master buffer
;; that shares the buffer-local values of its variables with the other buffers
;; via the macros `djvu-set' and `djvu-ref'.  We make the read buffer the
;; master buffer.  This choice is rather arbitrary.  The main reason for
;; this choice is that the read buffer is usually the main buffer to work
;; with.  So it becomes easier to inspect the document-local variables.

(defmacro djvu-set (var val &optional doc)
  "Set VAR's value to VAL in Djvu document DOC, and return VAL.
DOC defaults to `djvu-doc'."
  ;; `intern' VAR only once upon compilation
  (let ((var (intern (format "djvu-doc-%s" var)))
        (tmpval (make-symbol "tmpval")))
    ;; There is no equivalent of `buffer-local-value' for setting VAR.
    ;; Therefore, we need to make buffer DOC current before we can set VAR.
    ;; But we evaluate VAL in the current buffer before making DOC current.
    `(let ((,tmpval ,val))
       (with-current-buffer (or ,doc djvu-doc)
         (set ',var ,tmpval)))))

(defmacro djvu-ref (var &optional doc)
  "Return VAR's value in Djvu document DOC.
DOC defaults to `djvu-doc'."
  ;; `intern' VAR only once upon compilation
  (let ((var (intern (format "djvu-doc-%s" var))))
   `(buffer-local-value ',var (or ,doc djvu-doc))))

(defun djvu-header-line (identifier)
  (list (propertize " " 'display '(space :align-to 0))
        ;; Emacs >= 26: compare `proced-header-line'
        (format "%s -- %s (p%d)" (buffer-name (djvu-ref read-buf))
                identifier (djvu-ref page))))

(defsubst djvu-substring-number (string &optional from to base)
  "Parse substring of STRING as a decimal number and return the number.
If BASE, interpret STRING as a number in that base."
  (string-to-number (substring-no-properties string from to) base))

(defsubst djvu-match-number (num &optional string base)
  "Return string of text matched by last search, as a number.
If BASE, interpret match as a number in that base."
  (string-to-number (match-string num string) base))

(defsubst djvu-buffers (&optional doc)
  "Return a list of all buffers for DOC."
  (list (djvu-ref read-buf doc) (djvu-ref text-buf doc)
        (djvu-ref annot-buf doc) (djvu-ref shared-buf doc)
        (djvu-ref bookmarks-buf doc) (djvu-ref outline-buf doc)))

(defmacro djvu-all-buffers (doc &rest body)
  "Evaluate BODY in all buffers of Djvu DOC."
  (declare (indent 1))
  `(dolist (buf (djvu-buffers ,doc))
     (with-current-buffer buf
       ,@body)))

(defmacro djvu-with-temp-file (file &rest body)
  "Evaluate BODY with temp file FILE deleted at the end.
Preserve FILE if `djvu-test' is non-nil."
  (declare (indent 1) (debug (symbolp body)))
  `(let ((,file (make-temp-file "djvu-")))
     (unwind-protect
         (progn ,@body)
       (unless djvu-test (delete-file ,file)))))

(defun djvu-switch-read (&optional doc dpos)
  "Switch to Djvu Read buffer."
  (interactive (list nil (djvu-dpos)))
  (switch-to-buffer (djvu-ref read-buf doc))
  (djvu-goto-read dpos))

(defun djvu-switch-text (&optional doc dpos)
  "Switch to Djvu Text buffer."
  (interactive (list nil (djvu-dpos)))
  (switch-to-buffer (djvu-ref text-buf doc))
  (djvu-goto-dpos 'word dpos))

(defun djvu-switch-annot (&optional doc dpos)
  "Switch to Djvu Annotations buffer."
  (interactive (list nil (djvu-dpos)))
  (switch-to-buffer (djvu-ref annot-buf doc))
  (if (djvu-goto-dpos "\\(?:rect\\|text\\)" dpos)
      ;; If we have matching buffer position in the annotations buffer,
      ;; put point at the end of the annotations string.
      (re-search-backward "\"")))

(defun djvu-switch-shared (&optional doc)
  "Switch to Djvu Shared Annotations buffer."
  (interactive)
  (switch-to-buffer (djvu-ref shared-buf doc)))

(defun djvu-switch-bookmarks (&optional doc page)
  "Switch to Djvu Bookmarks buffer."
  (interactive (list nil (if (eq djvu-buffer 'outline)
                             (djvu-outline-page)
                           (djvu-ref page))))
  ;; Try to go to the current page in the bookmarks buffer.
  ;; If this page is not defined, try to go to the nearest preceding page.
  (switch-to-buffer (djvu-ref bookmarks-buf doc))
  (when page
    (goto-char (point-min))
    (if (looking-at "(bookmarks")
        (while (and (< 0 page)
                    (not (re-search-forward
                          (format "\"#\\(%d\\|%s\\)\"" page
                                  (cdr (assq page (djvu-ref page-id doc))))
                          nil t)))
          (setq page (1- page))))))

(defun djvu-switch-outline (&optional doc page)
  "Switch to Djvu Outline buffer."
  (interactive (list nil (if (eq djvu-buffer 'bookmarks)
                             (djvu-bookmarks-page)
                           (djvu-ref page))))
  (switch-to-buffer (djvu-ref outline-buf doc))
  (if page (djvu-goto-outline page)))

(defun djvu-dpos (&optional doc)
  "Djvu position in current Djvu buffer."
  (cond ((eq djvu-buffer 'read)
         (djvu-read-dpos nil doc))
        ((eq djvu-buffer 'text)
         (djvu-text-dpos nil doc))
        ((eq djvu-buffer 'annot)
         (djvu-annot-dpos nil doc))))

(defun djvu-read-page ()
  "Read page number interactively."
  (let ((str (read-string (format "Page (f, 1-%d, l): " (djvu-ref pagemax)))))
    (cond ((string-match "\\`f" str) 1)
          ((string-match "\\`l" str) (djvu-ref pagemax))
          ((string-match "\\`[[:digit:]]+\\'" str)
           (string-to-number str))
          (t (user-error "Page `%s' invalid" str)))))

(defun djvu-next-page (n)
  "Go to the next page of this Djvu document."
  (interactive "p")
  (djvu-goto-page (+ (djvu-ref page) n)))

(defun djvu-prev-page (n)
  "Go to the previous page of this Djvu document."
  (interactive "p")
  (djvu-goto-page (- (djvu-ref page) n)))

(defun djvu-scroll-up-command (&optional arg)
  "Scroll text upward ARG lines; or near full screen if no ARG.
At the bottom of the page, when `djvu-continuous' is non-nil
go to the next page.
Prefix ARG may take the same values as arg ARG of `scroll-up-command'."
  (interactive "^P") ; same as `scroll-up-command'
  (if (and djvu-continuous
           (= (window-end) (point-max))
           (< (djvu-ref page) (djvu-ref pagemax)))
      (djvu-next-page 1)
    (condition-case nil          ; Grrr, we should not need this, but
        (scroll-up-command arg)
      (end-of-buffer nil))))     ; `mwheel-scroll' does not like this.

(defun djvu-scroll-down-command (&optional arg)
  "Scroll text downward ARG lines; or near full screen if no ARG.
At the top of the page, when `djvu-continuous' is non-nil
go to the previous page.
Prefix ARG may take the same values as arg ARG of `scroll-down-command'."
  (interactive "^P") ; same as `scroll-down-command'
  (if (and djvu-continuous
           (= (point-min) (window-start))
           (< 1 (djvu-ref page)))
      (progn
        (djvu-prev-page 1)
        (goto-char (point-max))
        (beginning-of-line)
        (recenter -3))
    (condition-case nil            ; Grrr, we should not need this, but
        (scroll-down-command arg)
      (beginning-of-buffer nil)))) ; `mwheel-scroll' does not like this.

(defun djvu-next-line (&optional _arg _try-vscroll)
  "Move cursor vertically down ARG lines.
ARG and TRY-VSCROLL have the same meaning as for `next-line'.
At the bottom of the page, when `djvu-continuous' is non-nil,
go to the next page."
  ;; The interactive spec gives both args the numeric value
  ;; of `current-prefix-arg'.
  (interactive "^p\np") ; same as `next-line'
  (if (and djvu-continuous
           (= (line-end-position) (point-max))
           (< (djvu-ref page) (djvu-ref pagemax)))
      (djvu-next-page 1)
    (call-interactively 'next-line)))

(defun djvu-prev-line (&optional _arg _try-vscroll)
  "Move cursor vertically up ARG lines.
ARG and TRY-VSCROLL have the same meaning as for `previous-line'.
At the top of the page, when `djvu-continuous' is non-nil,
go to the previous page."
  ;; The interactive spec gives both args the numeric value
  ;; of `current-prefix-arg'.
  (interactive "^p\np") ; same as `previous-line'
  (if (and djvu-continuous
           (= (point-min) (line-beginning-position))
           (< 1 (djvu-ref page)))
      (progn
        (djvu-prev-page 1)
        (goto-char (point-max))
        (beginning-of-line)
        (recenter -3))
    (call-interactively 'previous-line)))

(defun djvu-history-backward ()
  "Go backward in the history of visited pages."
  (interactive)
  (let ((history-backward (djvu-ref history-backward))
        (history-forward (cons (djvu-ref page)
                               (djvu-ref history-forward))))
    (unless history-backward
      (user-error "This is the first page you looked at"))
    (djvu-goto-page (car history-backward))
    (djvu-set history-backward (cdr history-backward))
    (djvu-set history-forward history-forward)))

(defun djvu-history-forward ()
  "Go forward in the history of visited pages."
  (interactive)
  (let ((history-forward (djvu-ref history-forward)))
    (unless history-forward
      (user-error "This is the last page you looked at"))
    (djvu-goto-page (car history-forward))
    (djvu-set history-forward (cdr history-forward))))

(defun djvu-kill-view (&optional doc all)
  "Kill most recent Djview process for DOC.
If ALL is non-nil, kill all Djview processes."
  (interactive (list nil current-prefix-arg))
  (let ((proc-list (djvu-ref view-proc doc)) proc nproc-list)
    ;; Clean up process list
    (while (setq proc (pop proc-list))
      (unless (memq (process-status proc) '(exit signal))
        (push proc nproc-list)))
    (setq proc-list (nreverse nproc-list))
    (while (setq proc (pop proc-list))
      (quit-process proc)
      (djvu-set view-proc proc-list)
      (unless all (setq proc-list nil)))))

(defun djvu-kill-doc (&optional doc)
  "Kill all buffers visiting DOC.
This relies on `djvu-kill-doc-all' for doing the real work."
  (interactive)
  ;; `djvu-kill-doc-all' will try to save our work and kill all djview
  ;; processes.
  (mapc #'kill-buffer (djvu-buffers doc)))

(defvar djvu-in-kill-doc nil
  "Non-nil if we are running `djvu-kill-doc-all'.")

(defun djvu-kill-doc-all ()
  "Kill all buffers visiting `djvu-doc' except for the current buffer.
This function is added to `kill-buffer-hook' of all buffers visiting `djvu-doc'
so that killing the current buffer kills all buffers visiting `djvu-doc'."
  (unless djvu-in-kill-doc
    (let ((djvu-in-kill-doc t)
          buffers)
      ;; Sometimes we choke on broken djvu files so that many things
      ;; do not work anymore the way they should.  At least, we want to
      ;; be able to kill the relevant buffers.  So do not bail out here.
      (condition-case nil
          (let ((doc djvu-doc))
            (setq buffers (djvu-buffers doc))
            (unless (memq nil (mapcar #'buffer-live-p buffers))
                (djvu-save doc t))
            (djvu-kill-view doc t))
        (error nil))
      ;; A function in `kill-buffer-hook' should not kill the buffer
      ;; for which we called this hook in the first place, so that
      ;; other functions in this hook can do their job, too.
      (mapc #'kill-buffer (delq (current-buffer) buffers)))))

(defun djvu-change-major-mode ()
  "Clean up Djvu mode buffers and hooks.
Djvu mode puts this into `change-major-mode-hook'."
  (unless djvu-init
    (djvu-kill-doc-all)
    ;; These local variables are permanent local
    (kill-local-variable 'kill-buffer-hook)
    (kill-local-variable 'djvu-doc)
    (kill-local-variable 'revert-buffer-function)
    (kill-local-variable 'write-file-functions)
    (let ((inhibit-read-only t)
          (buffer-undo-list t))
      (insert-file-contents-literally buffer-file-name t nil nil t))
    (setq buffer-undo-list nil
          buffer-read-only (not (file-writable-p buffer-file-name)))))

(defun djvu-save (&optional doc query)
  "Save Djvu DOC."
  (interactive)
  (unless doc (setq doc djvu-doc))
  (let ((afile (abbreviate-file-name (djvu-ref file doc)))
        (text-modified  (buffer-modified-p (djvu-ref text-buf doc)))
        (annot-modified (buffer-modified-p (djvu-ref annot-buf doc)))
        (shared-modified (buffer-modified-p (djvu-ref shared-buf doc)))
        (bookmarks-modified (buffer-modified-p (djvu-ref bookmarks-buf doc))))
    (when (and (or text-modified annot-modified shared-modified bookmarks-modified)
               (or (and (verify-visited-file-modtime doc)
                        (or (not query)
                            (yes-or-no-p (format "Save %s? " afile))))
                   (yes-or-no-p (format "%s has changed since visited or saved.  Save anyway? "
                                        afile))))
      (djvu-with-temp-file script
        (if annot-modified (djvu-save-annot script doc))
        (if shared-modified (djvu-save-annot script doc t))
        (if text-modified (djvu-save-text doc script)) ; updates Read buffer
        (if bookmarks-modified (djvu-save-bookmarks script doc))
        (djvu-djvused doc nil "-f" script "-s"))
      (if (and annot-modified (not text-modified))
          (djvu-init-read (djvu-read-text doc) doc))
      (djvu-all-buffers doc
        (set-buffer-modified-p nil))))
  t) ; for `write-file-function'

(defun djvu-modified ()
  "Mark Djvu Read and Outline buffers as modified if necessary.
Used in `post-command-hook' of the Djvu Read, Text, Annotations,
Bookmarks and Outline buffers."
  (let ((modified (or (buffer-modified-p (djvu-ref bookmarks-buf))
                      (buffer-modified-p (djvu-ref text-buf))
                      (buffer-modified-p (djvu-ref annot-buf))
                      (buffer-modified-p (djvu-ref shared-buf)))))
    (with-current-buffer (djvu-ref read-buf)
      (set-buffer-modified-p modified))
    (with-current-buffer (djvu-ref outline-buf)
      (set-buffer-modified-p modified))))

(defun djvu-quit-window (&optional kill doc)
  "Quit all windows of Djvu document DOC and bury its buffers.
With prefix KILL non-nil, kill the buffers instead of burying them."
  (interactive "P")
  (unless doc (setq doc djvu-doc))
  (dolist (buf (djvu-buffers doc))
    (let ((window (get-buffer-window buf t)))
      (cond (window
             ;; Quitting one Djvu window may bring up again the Djvu window
             ;; of another Djvu buffer for the same Djvu document.
             ;; So we first remove these Djvu buffers from the list
             ;; of buffers previously displayed in this window.
             (let ((prev-buffers (window-prev-buffers window)))
               (dolist (b (djvu-buffers doc))
                 (setq prev-buffers (assq-delete-all b prev-buffers)))
               (set-window-prev-buffers window prev-buffers))
             (quit-window kill window))
            (kill
             (kill-buffer buf))
            (t
             (bury-buffer buf))))))

(defun djvu-djvused (doc buffer &rest args)
  "Process Djvu DOC by running the command djvused with ARGS.
BUFFER receives the process output, t means current buffer.
If BUFFER is nil, discard the process output, assuming that
the purpose of calling djvused is to update the Djvu file."
  (unless doc (setq doc djvu-doc))
  (unless (or buffer (file-writable-p (djvu-ref file doc)))
    (user-error "File `%s' not writable"
                (abbreviate-file-name (djvu-ref file doc))))
  (when (or buffer (not djvu-test))
    (unless buffer
      (djvu-backup doc))
    ;; We could separately preserve the error stream.  Yet this must go
    ;; into a file; it cannot go into a buffer.  So we'd have to check
    ;; in the end whether the file was non-empty and then delete it.
    (let* ((inhibit-quit t)
           (coding-system-for-read 'utf-8)
           (status (apply 'call-process "djvused" nil buffer nil
                          "-u" (djvu-ref file doc) args)))
      (unless (zerop status)
        (error "Djvused error %s (args: %s)" status args))
      (unless buffer
        (djvu-all-buffers doc
          (set-visited-file-modtime))))))

(defun djvu-backup (doc)
  "Make a backup of the disk file for Djvu document DOC, if appropriate."
  (with-current-buffer doc
    (unless buffer-backed-up
      (let* ((file (djvu-ref file doc))
             (real-file (file-chase-links file))
             (val (backup-buffer)))
        (when buffer-backed-up
          ;; Propagate the news
          (djvu-all-buffers doc
            (setq buffer-backed-up t))
          ;; Honor `backup-by-copying' and friends.
          ;; Yet if FILE does not exist anymore because `backup-buffer'
          ;; renamed it, we need to recreate FILE for djvused.
          ;; Strictly speaking, we recreate REAL-FILE because that is
          ;; the file that `backup-buffer' has renamed.
          ;; Then we also update the file-number for FILE.  Yet we
          ;; need not worry here about the modification time because
          ;; we called `djvu-backup' from something like `djvu-djvused',
          ;; which anyway needs to update the recorded modification time.
          (unless (file-exists-p real-file)
            (backup-buffer-copy (nth 2 val) real-file
                                (nth 0 val) (nth 1 val))
            (let ((file-number (nthcdr 10 (file-attributes file))))
              (djvu-all-buffers doc
                (setq buffer-file-number file-number)))))))))

;; The Emacs lisp reader gets confused by the Djvu color syntax with
;; symbols '#000000.  So we temporarily convert these symbols to strings.
(defun djvu-convert-hash (&optional reverse)
  "Convert color symbols #000000 to strings \"#000000\".
Perform inverse transformation if REVERSE is non-nil."
  (if reverse
      (let ((re (format djvu-color-re "\"" "#" "\"")))
        (goto-char (point-min))
        (while (re-search-forward re nil t)
          (replace-match (match-string 3) nil nil nil 2)))
    (let ((re (format djvu-color-re "#" "" "")))
      (goto-char (point-min))
      (while (re-search-forward re nil t)
        (replace-match (format "\"%s\"" (match-string 2)) nil nil nil 2)))))

;; Without this macro, we'd have to deactivate the region immediately,
;; before we have decided what to do with it.  That would be annoying.
;; Or leave the region active - equally annoying.
;; Also useful now: the region remains active if we abort the command
;; prematurely.
(defmacro djvu-with-region (region &rest body)
  "Provide REGION while executing BODY, deactivating REGION afterwards.
This is useful for the interactive spec of commands operating on REGION."
  (declare (indent 1) (debug (symbolp body)))
  `(let ((,region (let (beg end)
                    (if (use-region-p)
                        (setq beg (region-beginning)
                              end (region-end))
                      (setq beg (point) end beg))
                    (setq beg (djvu-property-beg beg 'word)
                          end (djvu-property-end end 'word))
                    (cons beg end))))
     (prog1 (progn ,@body)
       (if (and transient-mark-mode mark-active) (deactivate-mark)))))

(defun djvu-region-string (region &optional list)
  "Return REGION of current buffer as string.  REGION is a cons (BEG . END).
Apply replacements LIST to the buffer substring defined by REGION.
Each element in LIST is a cons (REGEXP . REP).
LIST defaults to `djvu-string-replace-list'.  Return the resulting string."
  (let ((string (buffer-substring-no-properties (car region)
                                                (cdr region)))
        case-fold-search)
    (dolist (elt (or list djvu-string-replace-list))
      (setq string (replace-regexp-in-string (car elt) (cdr elt) string)))
    string))

(defun djvu-read-string (prompt region &optional initial-input)
  "Read a string from the minibuffer, prompting with string PROMPT.
REGION is a cons (BEG . END) that defines the default.
If INITIAL-INPUT is non-nil use string from REGION as initial input."
  (if initial-input
      ;; Make the string in REGION the initial input.
      (read-string prompt (djvu-region-string region)
                   nil nil djvu-inherit-input-method)
    (read-string prompt nil nil (djvu-region-string region)
                 djvu-inherit-input-method)))

(defun djvu-interactive-color (color)
  "Return color specification for use in interactive calls.
The color is the Nth element of `djvu-color-alist'.
Here N is `current-prefix-arg' if this is a non-negative number.
N is 1 - `current-prefix-arg' / 4 if the prefix is a cons,
that is, `C-u' yields N = 0.
Arg COLOR defines the default when there is no prefix arg.
Return nil if `current-prefix-arg' is a negative number.
See also `djvu-interactive-color-read'."
  (let ((colnum (or (and (consp current-prefix-arg)
                         (1- (/ (car current-prefix-arg) 4)))
                    (and (integerp current-prefix-arg)
                         current-prefix-arg))))
    (cond ((not colnum) color) ; use default
          ((>= colnum (length djvu-color-alist))
           (user-error "Color undefined"))
          ((<= 0 colnum)
           (car (nth colnum djvu-color-alist))))))

(defun djvu-interactive-color-read ()
  "Read color interactively.
The return value is the car of an element of `djvu-color-alist'
or nil if the user selects \"transparent\".
See also `djvu-interactive-color'."
  (let ((color (completing-read "New Color: "
                                (cons '("transparent") djvu-color-alist )
                                nil t)))
     (unless (string= color "transparent")
       color)))

(defun djvu-page-url (&optional page dir doc)
  "For Djvu DOC return the internal url for PAGE.
This is the inverse of `djvu-url-page'."
  (let ((page (or page (djvu-ref page doc))))
    (format "#%s" (if (eq 'long (or dir (djvu-ref resolve-url doc)))
                      (cdr (assq page (djvu-ref page-id doc)))
                    page))))

(defun djvu-interactive-url (color)
  "Return URL specification for use in interactive calls."
  (let ((fmt (format "(%s) URL: " (or color "no color")))
        val)
    (while (not val)
      (setq val (read-string fmt))
      (cond ((string-match "\\`#?\\([0-9]+\\)\\'" val)
             (setq val (djvu-match-number 1 val))
             (if (<= 1 val (djvu-ref pagemax))
                 (setq val (djvu-page-url val))
               (message "Page number %d out of range (1-%d)"
                        val (djvu-ref pagemax))
               (sit-for 1)
               (setq val nil)))
            ((not (string-match "\\`[a-z]+://" val))
             (message "URL `%s' not recognized" val)
             (sit-for 1)
             (setq val nil))))
    val))

(defun djvu-color-background (color &optional background opacity invert)
  "For rgb COLOR and BACKGROUND apply OPACITY.
Return the new rgb color string.
If BACKGROUND is nil, use `djvu-color-background'.
If OPACITY is nil, use `djvu-opacity'.
If INVERT is non-nil apply inverse transformation."
  (when color
    (let* ((color (if (string-match "\\`#" color) color
                    (cdr (assoc color djvu-color-alist))))
           (background (if (and background (string-match "\\`#" background))
                           background
                         (cdr (assoc (or background djvu-color-background)
                                     djvu-color-alist))))
           (a (/ (float (or opacity djvu-opacity)) 200)) ; foreground
           (b (- 1 a))) ; background
      (if invert
          (cl-flet ((mix (beg end)
                         (max 0 (min #xFF
                                     (round (/ (- (djvu-substring-number color beg end 16)
                                                  (* b (djvu-substring-number background beg end 16)))
                                               a))))))
            (format "#%02X%02X%02X"
                    (mix 1 3) (mix 3 5) (mix 5 7)))
        (cl-flet ((mix (beg end)
                       (max 0 (min #xFF
                                   (round (+ (* a (djvu-substring-number color beg end 16))
                                             (* b (djvu-substring-number background beg end 16))))))))
          (format "#%02X%02X%02X"
                  (mix 1 3) (mix 3 5) (mix 5 7)))))))

;;; Djvu modes

(defvar djvu-read-mode-map
  (let ((km (make-sparse-keymap)))
    ;; `special-mode-map'
    ; (define-key km "?" 'describe-mode)
    ; (define-key km ">" 'end-of-buffer)
    ; (define-key km "<" 'beginning-of-buffer)

    (define-key km [remap scroll-up-command]   'djvu-scroll-up-command)
    (define-key km [remap scroll-down-command] 'djvu-scroll-down-command)
    (define-key km [remap next-line]           'djvu-next-line)
    (define-key km [remap previous-line]       'djvu-prev-line)

    (define-key km "i"           'djvu-image-toggle)
    (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 "f"           'djvu-history-forward)
    (define-key km "r"           'djvu-history-backward) ; "return"
    (define-key km "k"           'djvu-kill-doc)
    (define-key km "s"           'djvu-save)
    (define-key km "\C-x\C-s"    'djvu-save)
    (define-key km "q"           'djvu-quit-window)
    (define-key km "G"           'djvu-revert-buffer)
    (define-key km (kbd "C-c C-S-g") 'djvu-revert-buffer) ; [?\C-c ?\C-\S-g]

    ;; For switch commands we give short key bindings,
    ;; but for consistency we also provide the long bindings
    ;; used by `djvu-script-mode'.
    (define-key km "t"           'djvu-switch-text)
    (define-key km "\C-c\C-t"    'djvu-switch-text)
    (define-key km "\C-c\C-s"    'djvu-re-search-forward)
    (define-key km "\M-,"        'djvu-re-search-forward-continue)
    (define-key km "ee"          'djvu-edit-word)
    (define-key km "es"          'djvu-split-word)
    (define-key km "ew"          'djvu-merge-words)
    (define-key km "el"          'djvu-merge-lines)
    (define-key km "T"           'djvu-text-script)
    (define-key km "P"           'djvu-process-script)

    (define-key km "a"           'djvu-switch-annot)
    (define-key km "\C-c\C-a"    'djvu-switch-annot)
    (define-key km "S"           'djvu-switch-shared)
    (define-key km (kbd "C-c C-S-S") 'djvu-switch-shared)
    (define-key km "h"           'djvu-rect-region) ; highlight
    (define-key km "u"           'djvu-rect-region-url)
    (define-key km "A"           'djvu-annot-script)
    (define-key km "\C-c\C-c"    'djvu-update-color)
    (define-key km "\C-c\C-u"    'djvu-update-url)

    (define-key km "o"           'djvu-switch-outline)
    (define-key km "\C-c\C-o"    'djvu-switch-outline)
    (define-key km "b"           'djvu-switch-bookmarks)
    (define-key km "\C-c\C-b"    'djvu-switch-bookmarks)
    (define-key km "l"           'djvu-mark-line-beg)
    (define-key km "B"           'djvu-bookmark)
    (define-key km "m"           'djvu-himark)

    (define-key km "D"           'djvu-delete-page)
    (define-key km "U"           'djvu-resolve-all-urls)

    ;; unused: c j w x y z
    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"
    ["Djview File" djvu-view t]
    ["Toggle Image mode" djvu-image-toggle t]
    ["Go to Page" djvu-goto-page t]
    ["Save Doc" djvu-save t]
    ["Revert Doc" djvu-revert-buffer t]
    "---"
    ["Search Regexp Forward" djvu-re-search-forward t]
    ["Continue Search Re Forward" djvu-re-search-forward-continue t]
    "---"
    ("Operate on text layer"
     ["Edit Word" djvu-edit-word 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])
    ("Operate on annotations layer"
     ["Highlight Region" djvu-rect-region t]
     ["Page URL over Region" djvu-rect-region-url t]
     ["Himark Region" djvu-himark t]
     ["Mark point" djvu-mark-line-beg t]
     ["Update color" djvu-update-color t]
     ["Update url" djvu-update-url t]
     ["Switch to Annotations" djvu-switch-annot t]
     ["Switch to Shared Annotations" djvu-switch-shared t])
    ("Operate on bookmarks layer"
     ["Add Bookmark" djvu-bookmark t]
     ["Switch to Bookmarks" djvu-switch-bookmarks t]
     ["Switch to Outline" djvu-switch-outline t])
    ("Editing multiple pages"
     ["Resolve internal URLs" djvu-resolve-all-urls t]
     ["Text as Script" djvu-text-script t]
     ["Annotations as Script" djvu-annot-script t]
     ["Process Djvused Script" djvu-process-script t])
    ("Destructive commands"
     ["Delete current page" djvu-delete-page t]
     ["Remove Annot / Bookmarks" djvu-make-clean t])
    "---"
    ["Quit Viewing" djvu-quit-window t]
    ["Kill Djvu buffers" djvu-kill-doc t]))

(defvar bookmark-make-record-function)

(define-derived-mode djvu-read-mode special-mode "Djview"
  "Mode for reading Djvu files."
  (if (not djvu-init)
      (djvu-init-mode) ; For `doc-view-toggle-display' and `major-mode-suspend'
    ;; The Read buffer is not editable.  So do not create auto-save files.
    (setq buffer-auto-save-file-name nil ; permanent buffer-local
          djvu-buffer 'read
          buffer-undo-list t)
    (let ((fmt (concat (car (propertized-buffer-identification "%s"))
                       "  p%d/%d")))
      (setq mode-line-buffer-identification
            `(24 (:eval (format ,fmt (buffer-name) (djvu-ref page)
                                (djvu-ref pagemax))))))
    (setq-local revert-buffer-function #'djvu-revert-buffer)
    (setq-local bookmark-make-record-function #'djvu-bookmark-make-record)
    (if (boundp 'mwheel-scroll-up-function) ; not --without-x build
        (setq-local mwheel-scroll-up-function
                    (lambda (&optional n)
                      (if djvu-image-mode (djvu-image-scroll-up n)
                        (djvu-scroll-up-command n)))))
    (if (boundp 'mwheel-scroll-down-function)
        (setq-local mwheel-scroll-down-function
                    (lambda (&optional n)
                      (if djvu-image-mode (djvu-image-scroll-down n)
                        (djvu-scroll-down-command n)))))))

(defvar djvu-script-mode-map
  (let ((km (make-sparse-keymap)))
    (define-key km "\C-c\C-r"    'djvu-switch-read)
    (define-key km "\C-c\C-t"    'djvu-switch-text)
    (define-key km "\C-c\C-a"    'djvu-switch-annot)
    (define-key km (kbd "C-c C-S-S") 'djvu-switch-shared)
    (define-key km "\C-c\C-b"    'djvu-switch-bookmarks)
    (define-key km "\C-c\C-o"    'djvu-switch-outline)
    (define-key km "\C-c\C-g"    'djvu-goto-page)
    (define-key km "\C-c\C-p"    'djvu-prev-page)
    (define-key km "\C-c\C-n"    'djvu-next-page)
    (define-key km "\C-c\C-es"   'djvu-split-word-internal)
    (define-key km "\C-c\C-ew"   'djvu-merge-words-internal)
    (define-key km "\C-c\C-el"   'djvu-merge-lines-internal)
    (define-key km "\C-c\C-m"    'djvu-merge-mapareas)
    (define-key km "\C-c\C-c"    'djvu-update-color-internal)
    (define-key km "\C-c\C-u"    'djvu-update-url-internal)
    (define-key km "\C-c\C-z"    'djvu-resize-internal)
    (define-key km "\C-c\C-l"    'djvu-remove-linebreaks-internal)
    (define-key km "\C-x\C-s"    'djvu-save)
    (define-key km "\C-c\C-v"    'djvu-view)
    (define-key km "\C-c\C-q"    'djvu-quit-window)
    (define-key km "\C-c\C-k"    'djvu-kill-doc)
    (define-key km (kbd "C-c C-S-g") 'djvu-revert-buffer) ; [?\C-c ?\C-\S-g]

    km)
  "Keymap for Djvu Script Mode.
This is a child of `lisp-mode-map'.")

(easy-menu-define
  djvu-annot-menu djvu-script-mode-map "Djvu Menu"
  '("Djvu"
    ["Go to Page" djvu-goto-page t]
    ["Switch to Read" djvu-switch-read t]
    ["Switch to Text" djvu-switch-text (not (eq djvu-buffer 'text))]
    ["Switch to Annotations" djvu-switch-annot (not (eq djvu-buffer 'annot))]
    ["Switch to Shared Annotations" djvu-switch-shared (not (eq djvu-buffer 'shared))]
    ["Switch to Bookmarks" djvu-switch-bookmarks t]
    ["Switch to Outline" djvu-switch-outline t]
    ["Save Doc" djvu-save t]
    ["Revert Doc" djvu-revert-buffer t]
    "---"
    ;; These commands make sense only in the annotations buffer
    ["Merge Mapareas" djvu-merge-mapareas (eq djvu-buffer 'annot)]
    ["Update Color" djvu-update-color-internal (eq djvu-buffer 'annot)]
    ["Update URL" djvu-update-url-internal (eq djvu-buffer 'annot)]
    ["Resize Maparea" djvu-resize-internal (eq djvu-buffer 'annot)]
    ["Remove Linebreaks" djvu-remove-linebreaks-internal (eq djvu-buffer 'annot)]
    "---"
    ;; These commands make sense only in the text buffer
    ["Split Word" djvu-split-word-internal (eq djvu-buffer 'text)]
    ["Merge Words" djvu-merge-words-internal (eq djvu-buffer 'text)]
    ["Merge Lines" djvu-merge-lines-internal (eq djvu-buffer 'text)]
    "---"
    ["Quit Djvu" djvu-quit-window t]
    ["Kill Djvu buffers" djvu-kill-doc t]))

(defvar djvu-font-lock-keywords
  `((,(concat "^[ \t]*("
              (regexp-opt '("background" "zoom" "mode" "align"
                            "maparea" "metadata" "bookmarks" "xmp")
                          t))
     1 font-lock-keyword-face)
    (,(concat "\\(?:[ \t]+\\|^\\|(\\)("
              (regexp-opt '("url" "rect" "oval" "poly" "text" "line"
                            "none" "xor" "border" "shadow_in"
                            "shadow_out" "shadow_ein" "shadow_eout"
                            "border_avis" "hilite" "opacity"
                            "arrow" "width" "lineclr"
                            "backclr" "textclr" "pushpin"
                            "page" "column" "region" "para" "line"
                            "word" "char")
                          t)
              ")")
     1 font-lock-function-name-face)
    ;; url
    (djvu-font-lock-url))
  "Font lock keywords for Djvu buffers.")

(define-derived-mode djvu-script-mode lisp-mode "Djvu Script"
  "Mode for editing Djvu scripts.
The annotations, shared annotations and bookmark buffers use this mode."
  (if (not djvu-init)
      (djvu-init-mode) ; For `doc-view-toggle-display' and `major-mode-suspend'
    ;; Fixme: we should create auto-save files for the script buffers.
    ;; This requires suitable names for the auto-save files that should
    ;; be derived from `buffer-file-name'.
    (setq buffer-auto-save-file-name nil ; permanent buffer-local
          fill-column djvu-fill-column
          font-lock-defaults '(djvu-font-lock-keywords))
    (let* ((fmt1 (car (propertized-buffer-identification "%s")))
           (fmt2 (concat fmt1 "  p%d/%d")))
      (setq mode-line-buffer-identification
            `(24 (:eval (if djvu-doc
                            (format ,fmt2 (buffer-name) (djvu-ref page)
                                    (djvu-ref pagemax))
                          (format ,fmt1 (buffer-name)))))))
    (setq-local revert-buffer-function #'djvu-revert-buffer)
    (setq-local bookmark-make-record-function #'djvu-bookmark-make-record)))

(defvar djvu-outline-mode-map
  (let ((km (make-sparse-keymap)))
    ;; `special-mode-map'
    ; (define-key km " " 'scroll-up-command)
    ; (define-key km [?\S-\ ] 'scroll-down-command)
    ; (define-key km "\C-?" 'scroll-down-command)
    ; (define-key km "?" 'describe-mode)
    ; (define-key km ">" 'end-of-buffer)
    ; (define-key km "<" 'beginning-of-buffer)

    (define-key km "v"           'djvu-view-page)
    (define-key km "\C-c\C-v"    'djvu-view-page)
    (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 "s"           'djvu-save)
    (define-key km "\C-x\C-s"    'djvu-save)
    (define-key km "q"           'djvu-quit-window)
    (define-key km "G"           'djvu-revert-buffer)
    (define-key km (kbd "C-c C-S-g") 'djvu-revert-buffer) ; [?\C-c ?\C-\S-g]

    ;; For switch commands we give short key bindings,
    ;; but for consistency we also provide the long bindings
    ;; used by `djvu-script-mode'.
    (define-key km "a"           'djvu-switch-annot)
    (define-key km "\C-c\C-a"    'djvu-switch-annot)
    (define-key km "S"           'djvu-switch-shared)
    (define-key km (kbd "C-c C-S-S") 'djvu-switch-shared)
    (define-key km "b"           'djvu-switch-bookmarks)
    (define-key km "\C-c\C-b"    'djvu-switch-bookmarks)
    (define-key km "t"           'djvu-switch-text)
    (define-key km "\C-c\C-t"    'djvu-switch-text)
    (define-key km "r"           'djvu-switch-read)
    (define-key km "\C-c\C-r"    'djvu-switch-read)

    km)
  "Keymap for Djvu Outline Mode.
This is a child of `special-mode-map'.")

(easy-menu-define
  djvu-outline-menu djvu-outline-mode-map "Djvu Menu"
  '("Djvu"
    ["Djview File" djvu-view-page t]
    ["Go to Page" djvu-goto-page t]
    ["Save Doc" djvu-save t]
    ["Revert Doc" djvu-revert-buffer t]
    "---"
    ["Switch to Read" djvu-switch-read t]
    ["Switch to Text" djvu-switch-text t]
    ["Switch to Annotations" djvu-switch-annot t]
    ["Switch to Shared Annotations" djvu-switch-shared t]
    ["Switch to Bookmarks" djvu-switch-bookmarks t]
    "---"
    ["Quit Viewing" djvu-quit-window t]
    ["Kill Djvu buffers" djvu-kill-doc t]))

(define-derived-mode djvu-outline-mode special-mode "Djvu OL"
  "Mode for reading the outline of Djvu files."
  (if (not djvu-init)
      (djvu-init-mode) ; For `doc-view-toggle-display' and `major-mode-suspend'
    ;; The Outline buffer is not editable.  So do not create auto-save files.
    (setq buffer-auto-save-file-name nil ; permanent buffer-local
          djvu-buffer 'outline
          buffer-undo-list t)
    (let ((fmt (concat (car (propertized-buffer-identification "%s"))
                       "  p%d/%d")))
      (setq mode-line-buffer-identification
            `(24 (:eval (format ,fmt (buffer-name) (djvu-ref page)
                                (djvu-ref pagemax))))))
    (setq-local revert-buffer-function #'djvu-revert-buffer)
    (setq-local bookmark-make-record-function #'djvu-bookmark-make-record)))

;;; General Setup

;;;###autoload
(add-to-list 'auto-mode-alist '("\\.djvu\\'" . djvu-init-mode))

;;;###autoload
(defun djvu-init-mode ()
  "Dummy mode for initializing Djvu mode.
This can be used as an element for `auto-mode-alist'.
This can also be used if the current buffer visits a Djvu file
using some other mode."
  (interactive)
  (djvu-find-file buffer-file-name nil nil t))

(defun djvu-read-file-name ()
  "Read file name of Djvu file.
The numeric value of `current-prefix-arg' is the page number."
  (let ((page (prefix-numeric-value current-prefix-arg)))
    ;; We cannot create a djvu file.  The file must exist when we open it.
    (list (read-file-name "Find Djvu file: " nil nil t nil
                          (lambda (f)
                            (or (equal "djvu" (file-name-extension f))
                                (file-directory-p f))))
          page)))

;;;###autoload
(defun djvu-find-file (file &optional page view noselect noconfirm)
  "Read and edit Djvu FILE on PAGE.  Return Read buffer.
If VIEW is non-nil start external viewer.
If NOSELECT is non-nil visit FILE, but do not make it current.
If NOCONFIRM is non-nil don't ask for confirmation when reverting buffer
from file."
  (interactive (djvu-read-file-name))
  (unless page (setq page 1))
  (setq file (expand-file-name file))
  ;; Djvu mode needs a local file.  If FILE is located on a remote system,
  ;; you can use something like `file-local-copy' to edit FILE.
  (if (file-remote-p file)
      (user-error "Cannot handle remote Djvu file `%s'" file))
  (unless (and (file-regular-p file)
               (file-readable-p file))
    (user-error "Cannot open Djvu file `%s'" file))
  (with-temp-buffer
    (insert-file-contents-literally file nil 0 4)
    (goto-char (point-min))
    (unless (looking-at "\\`AT&T") ; magic number for Djvu documents
      (user-error "`%s' not a Djvu document" file)))
  (let* ((inhibit-quit t)
         (buf-basename (file-name-nondirectory file))
         (file-truename (abbreviate-file-name (file-truename file)))
         (file-number (nthcdr 10 (file-attributes file)))
         (dir (file-name-directory file))
         (read-only (not (file-writable-p file)))
         (doc (if (equal buffer-file-truename file-truename)
                  (current-buffer)
                (find-buffer-visiting file-truename)))
         (old-bufs (and doc (buffer-local-value 'djvu-doc doc)
                        (mapcar #'buffer-live-p (djvu-buffers doc))))
         (djvu-init t))
    ;; Sanity check.  We should never need this.
    (when (and old-bufs (memq nil old-bufs))
      (message "Killing dangling Djvu buffers...")
      (with-current-buffer doc
        (djvu-kill-doc-all))
      (setq old-bufs nil)
      (message "Killing dangling Djvu buffers...Done")
      (sit-for 2))
    ;; Do nothing if we are already visiting FILE such that all buffers
    ;; are properly defined and FILE's modtime matches what we expect.
    (unless (and old-bufs
                 (or (and (equal file-number
                                 (buffer-local-value 'buffer-file-number doc))
                          (verify-visited-file-modtime doc))
                     ;; If a file on disk and a Djvu session are out of sync,
                     ;; we can only continue in hairy, limited ways because
                     ;; Emacs does not copy the contents of FILE into a buffer.
                     ;; Instead, we entirely rely on djvused.
                     (not (or noconfirm
                              (yes-or-no-p
                               (format "Revert buffer from file %s? "
                                       (djvu-ref file doc)))))))
      (unless old-bufs
        (cl-flet ((fun (n)
                       ;; Instead of `generate-new-buffer', we take a detour
                       ;; via `create-file-buffer' so that uniquify can do
                       ;; its job, too.  It does not matter that the arg of
                       ;; `create-file-buffer' does not match `buffer-file-name'
                       ;; because `uniquify-buffer-file-name' only cares
                       ;; about DIR.
                       (create-file-buffer ; needed by uniquify
                        (expand-file-name
                         (concat buf-basename
                                 (nth n djvu-buffer-name-extensions))
                         dir))))
          (if doc
              ;; This applies if `find-file-noselect' created OLD-BUF
              ;; in order to visit FILE.  Hence recycle OLD-BUF as Read
              ;; buffer.  This applies also if we switch from some other
              ;; mode to Djview mode.
              (with-current-buffer doc
                (let ((inhibit-read-only t)
                      (buffer-undo-list t))
                  (erase-buffer))
                (setq buffer-file-coding-system 'prefer-utf-8)
                ;; `rename-buffer' obeys uniquify.
                (rename-buffer (concat buf-basename
                                       (nth 0 djvu-buffer-name-extensions))
                               t))
            ;; We need this when mimicking `find-file'
            ;; so that FILE does not yet have a buffer.
            (setq doc (fun 0)))
          (djvu-set read-buf doc doc)
          (djvu-set text-buf (fun 1) doc)
          (djvu-set annot-buf (fun 2) doc)
          (djvu-set shared-buf (fun 3) doc)
          (djvu-set bookmarks-buf (fun 4) doc)
          (djvu-set outline-buf (fun 5) doc)))
      ;; Of course, we have
      ;; `djvu-doc-read-buf' = `djvu-doc'
      ;; `djvu-doc-file' = `buffer-file-name'.  Bother?
      ;; It seems Emacs does not like aliases for buffer-local variables.
      (djvu-set file file doc)
      ;; We could set the resolve-url flag heuristically, if the Djvu file
      ;; happens to have bookmarks or internal urls on the current page.
      ;; (djvu-set resolve-url nil doc)

      ;; (Re-)Initialize all buffers.
      (with-current-buffer (djvu-ref read-buf doc)
        (djvu-read-mode))
      (with-current-buffer (djvu-ref outline-buf doc)
        (djvu-outline-mode))
      (with-current-buffer (djvu-ref text-buf doc)
        (djvu-script-mode)
        (setq djvu-buffer 'text))
      (with-current-buffer (djvu-ref annot-buf doc)
        (djvu-script-mode)
        (setq djvu-buffer 'annot
              header-line-format '(:eval (djvu-header-line "page annotations"))))
      (with-current-buffer (djvu-ref shared-buf doc)
        (djvu-script-mode)
        (setq djvu-buffer 'shared
              header-line-format '(:eval (djvu-header-line "shared annotations"))))
      (with-current-buffer (djvu-ref bookmarks-buf doc)
        (djvu-script-mode)
        (setq djvu-buffer 'bookmarks
              header-line-format '(:eval (djvu-header-line "bookmarks"))))
      (djvu-all-buffers doc
        ;; permanent buffer-local variables
        (setq djvu-doc doc ; propagate DOC to all buffers
              buffer-file-name file
              ;; A non-nil value of `buffer-file-truename' enables file-locking,
              ;; see call of `lock_file' in `prepare_to_modify_buffer_1'
              buffer-file-truename file-truename
              buffer-file-number file-number
              default-directory dir)
        ;; other buffer-local stuff
        (setq buffer-file-read-only read-only
              ;; We assume that all buffers for a Djvu document have the same
              ;; read-only status.  Should we allow different values for the
              ;; buffers of one document?
              ;; Or do we need a `djvu-read-only-mode'?
              buffer-read-only read-only)
        (setq-local write-file-functions #'djvu-save)
        (set-visited-file-modtime)
        (add-hook 'post-command-hook #'djvu-modified nil t)
        (add-hook 'kill-buffer-hook #'djvu-kill-doc-all nil t)
        (add-hook 'change-major-mode-hook #'djvu-change-major-mode nil t))

      (with-temp-buffer
        (djvu-djvused doc t "-e"
                      "create-shared-ant; print-ant; n; ls; print-outline;")
        (goto-char (point-min))

        ;; shared annotations
        (save-restriction
          (narrow-to-region
           (point)
           ;; There is no delimiter in between the output strings
           ;; of multiple djvused commands indicating something like
           ;; the last shared annotation.
           ;; So we simply rely on the fact that annotations have a
           ;; parsable lisp-like syntax surrounded by braces,
           ;; whereas the next djvused command is `n', the output
           ;; of which is a plain number.
           (save-excursion
             (while (progn (skip-chars-forward " \t\n")
                           (looking-at "("))
               (forward-sexp))
             (point)))
          (djvu-init-annot (djvu-ref shared-buf doc) doc t))

        ;; page max
        (djvu-set pagemax (read (current-buffer)) doc)

        ;; page id:
        ;; The output lines of djvused -e "ls;" consists of several parts
        (let ((regexp (concat "\\(?:\\([0-9]+\\)[ \t]+\\)?" ; page number
                              "\\([PIAT]\\)[ \t]+"          ; file identifier
                              "\\([0-9]+\\)[ \t]+"          ; file size
                              ;; We have a problem when parsing the
                              ;; component file name followed by the optional
                              ;; page title: there is no unambiguous separator
                              ;; in between the two.  Note that the component
                              ;; file name may contain whitespace characters
                              ;; and its file name extension is not unique
                              ;; (if present at all).
                              "\\([^=\n]+\\)"
                              "\\(?:[ \t]+T=[^\t\n]+\\)?"  ; title (optional)
                              "$")) ; match a single line
              page-id)
          (while (progn (skip-chars-forward " \t\n")
                        (looking-at regexp))
            (if (match-string 1)
                ;; page-id is an alist with elements (PAGE-NUM . FILE-ID).
                ;; The remainder of the code assumes that djvused sets up
                ;; this association list properly.
                (push (cons (djvu-match-number 1)
                            (match-string 4))
                      page-id))
            (goto-char (match-end 0)))
          (unless (eq (djvu-ref pagemax doc) (length page-id))
            (error "Page id list broken %s - %s"
                   (djvu-ref pagemax doc) (length page-id)))
          (djvu-set page-id (nreverse page-id) doc))

        ;; bookmarks
        (skip-chars-forward " \t\n")
        (when (looking-at "(bookmarks")
          (let ((object (read (current-buffer))))
            (with-current-buffer (djvu-ref bookmarks-buf doc)
              (let (buffer-read-only)
                (erase-buffer)
                (insert "(bookmarks")
                (djvu-insert-bookmarks (cdr object) " ")
                (insert ")\n")
                (goto-char (point-min))
                (set-buffer-modified-p nil)
                (setq buffer-undo-list nil)))
            (djvu-init-outline (cdr object) doc))))

      (djvu-init-page page doc))

    (if view (djvu-view doc))
    (unless noselect (switch-to-buffer (djvu-ref read-buf doc)))
    (djvu-ref read-buf doc)))

(defun djvu-revert-buffer (&optional _ignore-auto noconfirm _preserve-modes)
  "Revert buffers for the current Djvu document.
Note: Djvu mode never visits the Djvu document in the usual Emacs sense of
copying the contents of the file into a buffer to manipulate it.  Instead,
djvu mode completely relies on djvused and the file on disk.  Therefore,
we are in trouble if the file on disk happens to be not in sync anymore
with what Djvu mode believes it is.  Reverting the buffers for the Djvu
document is usually the only way out."
  (interactive)
  (unless djvu-doc (user-error "No djvu-doc"))
  ;; Force reversal.  Is there a better way to achieve this?
  ;; Emacs will ask a few questions if some buffers are modified.
  (with-current-buffer djvu-doc
    (setq buffer-file-number nil))
  (djvu-find-file (djvu-ref file djvu-doc)
                  (djvu-ref page djvu-doc) nil nil noconfirm))

(defun djvu-init-page (&optional page doc)
  "Initialize PAGE for Djvu DOC.
PAGE is re-initialized if we are already viewing it."
  (interactive (list (djvu-read-page)))
  (unless doc (setq doc djvu-doc))
  ;; No need to save if only the bookmarks buffer
  ;; or shared annotations buffer got modified.
  (if (or (buffer-modified-p (djvu-ref text-buf doc))
          (buffer-modified-p (djvu-ref annot-buf doc)))
      (djvu-save doc t))
  ;; We process PAGE unconditionally, even if it equals the page
  ;; currently displayed.  Most often, PAGE equals the current page
  ;; if we want to redisplay PAGE.
  (unless (integerp page)
    (setq page (or (djvu-ref page doc) 1)))
  (if (or (< page 1)
          (< (djvu-ref pagemax doc) page))
      (user-error "Page `%s' out of range" page))

  (let ((inhibit-quit t))
    (if (and (djvu-ref page doc)
             (not (equal page (djvu-ref page doc))))
        (djvu-set history-backward (cons (djvu-ref page doc)
                                         (djvu-ref history-backward doc))
                  doc))
    (djvu-set history-forward nil doc)
    (djvu-set page page doc)
    ;; Fix me: Restore buffer positions if we revisit the same page.
    (djvu-set read-pos nil doc)
    (with-temp-buffer
      (djvu-djvused doc t "-e"
                    (format "select %d; size; print-txt; print-ant;"
                            (djvu-ref page doc)))
      (goto-char (point-min))

      ;; page size
      (skip-chars-forward " \t\n")
      (if (looking-at "width=\\([[:digit:]]+\\)[ \t]+height=\\([[:digit:]]+\\)\\(?:[ \t]+rotation=\\([[:digit:]]+\\)\\)?$")
          (djvu-set pagesize (cons (djvu-match-number 1)
                                   (djvu-match-number 2))
                    doc)
        ;; This may fail if the file list we read previously contained
        ;; thumbnails.  We should really ignore these thumbnails.
        (error "No page size"))

      ;; Raw text:
      ;; This is exactly one object that we can swallow in one bite.
      ;; Hence we do this before we swallow the unknown number of annotations.
      (goto-char (match-end 0))
      (skip-chars-forward " \t\n")
      (let ((object (if (looking-at "(\\(page\\|column\\|region\\|para\\|line\\|word\\|char\\)")
                        (read (current-buffer)))))
        ;; Set up annotations buffer.
        ;; This also initializes `djvu-doc-rect-list' that we need
        ;; for propertizing the read buffer.
        (save-restriction
          (narrow-to-region (point) (point-max))
          (djvu-init-annot (djvu-ref annot-buf doc) doc))

        ;; Set up text buffer
        (djvu-init-text object doc t)

        ;; Set up read buffer
        (djvu-init-read object doc t)))))

(defalias 'djvu-goto-page 'djvu-init-page
  "Goto PAGE of Djvu document DOC.")

(defsubst djvu-unresolve-url (url)
  "Unresolve internal URL.
This issues a warning message if URL cannot be resolved.
Yet it does not throw an error that would put the Djvu document
into an undefined state."
  (message "Warning: Page id `%s' broken" url)
  (sit-for 1)
  url)

(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 (assq (djvu-substring-number url 1)
                                     (djvu-ref page-id doc))))
                  (if page-id
                      (format "#%s" (cdr page-id))
                    (djvu-unresolve-url url))))
               ((string-match "\\`#" url)
                (if (rassoc (substring-no-properties url 1)
                            (djvu-ref page-id doc))
                    url
                  (djvu-unresolve-url url)))
               (t url))) ; some other URL
        ((eq 'short djvu-resolve-url)
         ;; Replace file id by page number
         (cond ((string-match "\\`#[0-9]+\\'" url)
                (if (assq (djvu-substring-number url 1)
                          (djvu-ref page-id doc))
                    url
                  (djvu-unresolve-url url)))
               ((string-match "\\`#" url)
                (let ((page-id (rassoc (substring-no-properties url 1)
                                       (djvu-ref page-id doc))))
                  (if page-id
                      (format "#%d" (car page-id))
                    (djvu-unresolve-url url))))
               (t "#1"))) ; some other URL (possibly empty string)
        (t ; check whether URL can be resolved
         (cond ((string-match "\\`#[0-9]+\\'" url)
                (if (assq (djvu-substring-number url 1)
                          (djvu-ref page-id doc))
                    url
                  (djvu-unresolve-url url)))
               ((string-match "\\`#" url)
                (if (rassoc (substring-no-properties url 1)
                            (djvu-ref page-id doc))
                    url
                  (djvu-unresolve-url url)))
               (t url))))) ; some other URL

(defun djvu-resolve-all-urls (dir &optional doc)
  "Resolve all internal URLs in Djvu document DOC."
  (interactive
   (list (intern (completing-read "Direction: " '((long) (short)) nil t))))
  (unless doc (setq doc djvu-doc))
  (djvu-save doc t)
  (unless (eq dir (djvu-ref resolve-url doc))
    (if (djvu-modified) (user-error "Djvu file should be saved"))
    ;; Resolve annotations
    (with-temp-buffer
      (let ((page-id (djvu-ref page-id doc))
            (djvu-resolve-url dir))
        (djvu-annot-script doc t)
        (goto-char (point-min))
        ;; The following regexp ignores external URLs
        ;; which do not start with "#".
        (while (re-search-forward "^(maparea[ \t]+\"#\\(\\([0-9]+\\)\\|[^\"]*[^0-9\"][^\"]*\\)\"" nil t)
          (let* ((url (match-string 1))
                 (num (and (match-string 2)
                           (djvu-match-number 2)))
                 repl)
            (cond ((eq dir 'long)
                   (if num
                       (if (setq repl (cdr (assq num page-id)))
                           (replace-match repl nil nil nil 1)
                         (djvu-unresolve-url url))
                     ;; We already have a long url
                     (unless (rassoc url page-id)
                       (djvu-unresolve-url url))))

                  ;; (eq dir 'short)
                  (num
                   ;; We already have a short url
                   (unless (assq num page-id)
                     (djvu-unresolve-url url)))
                  ((setq repl (car (rassoc url page-id)))
                   (replace-match (number-to-string repl) nil nil nil 1))
                  (t (djvu-unresolve-url url)))))
        (djvu-process-script doc t)))

    ;; update internal URLs of current page
    (with-temp-buffer
      (djvu-djvused doc t "-e"
                    (format "select %d; print-ant;" (djvu-ref page doc)))
      (djvu-init-annot (djvu-ref annot-buf doc) doc))

    ;; Resolve bookmarks
    (let ((object (djvu-read-bookmarks doc))
          (djvu-resolve-url dir))
      (when object
        (with-current-buffer (djvu-ref bookmarks-buf doc)
          (erase-buffer)
          (insert "(bookmarks")
          (djvu-insert-bookmarks (cdr object) " ")
          (insert ")\n"))
        (djvu-save doc)))
    (djvu-set resolve-url dir doc)))

(defun djvu-area (area &optional back)
  "Convert (area xmin ymin width height) to (area xmin ymin xmax ymax).
If BACK is non-nil do inverse transformation."
  (if back
      (let ((lst (list (nth 0 area) (nth 1 area) (nth 2 area)
                       (- (nth 3 area) (nth 1 area))
                       (- (nth 4 area) (nth 2 area)))))
        ;; Only for back transforms we might get an error...
        (if (or (> 0 (nth 3 lst)) (> 0 (nth 4 lst)))
            (message "Annotation area dimensions %s, %s"
                     (nth 3 lst) (nth 4 lst)))
        lst)
    (list (nth 0 area) (nth 1 area) (nth 2 area)
          (+ (nth 3 area) (nth 1 area))
          (+ (nth 4 area) (nth 2 area)))))

(defun djvu-view (&optional doc new)
  "(Re)Start Djview for DOC.
If prefix NEW is non-nil, always create a new Djview process."
  (interactive (list nil current-prefix-arg))
  (if (not (display-graphic-p))
      (message "No graphic display available")
    (let* ((doc (or doc djvu-doc)) ; needed by process-sentinel
           (dpos (djvu-mean-dpos (djvu-read-dpos nil doc)))
           (px (/ (float (nth 0 dpos))
                  (float (car (djvu-ref pagesize doc)))))
           (py (- 1 (/ (float (nth 1 dpos))
                       (float (cdr (djvu-ref pagesize doc))))))
           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))
      (unless new (djvu-kill-view doc))
      (let ((process (apply 'start-process
                    "djview" nil djvu-djview-command
                    (format "-page=%s" (cdr (assq (djvu-ref page doc)
                                                  (djvu-ref page-id doc))))
                    (format "-showposition=%06f,%06f" px py)
                    (append djvu-djview-options (list (djvu-ref file doc))))))
        (set-process-sentinel
         process
         `(lambda (process event)
            (when (string-match "^\\(?:finished\\|exited\\|quit\\|killed\\|terminated\\)" event)
              ;; This code runs asynchronously.  The buffer DOC need not
              ;; be alive anymore when we run `djvu-ref' and `djvu-set'.
              (if (buffer-live-p ,doc)
                  (djvu-set view-proc (delq process (djvu-ref view-proc ,doc))
                            ,doc))
              (message "%s %s: %s" process
                       ,(abbreviate-file-name (djvu-ref file doc))
                       event))))
        (djvu-set view-proc (cons process (djvu-ref view-proc doc)) doc)))))

(defun djvu-view-page (page &optional doc new)
  "(Re)Start Djview on PAGE for DOC.
If prefix NEW is non-nil, always create a new Djview process."
  (interactive (list (if (eq 'outline djvu-buffer)
                         (djvu-outline-page)
                       (djvu-read-page))
                     nil current-prefix-arg))
  (djvu-goto-page page doc)
  (djvu-view doc new))

;;; Djvu Text mode

(defun djvu-re-search-forward (regexp)
  "Search forward for match for REGEXP.
Search case-sensitivity is determined by the value of the variable
`case-fold-search', which see.
The command `djvu-re-search-forward-continue' continues to search forward."
  (interactive "sSearch (regexp): ")
  (setq djvu-last-search-re regexp)
  (let ((doc djvu-doc))
    (while (not (or (re-search-forward regexp nil t)
                    (eq (djvu-ref page doc) (djvu-ref pagemax doc))))
      (djvu-next-page 1))))

(defun djvu-re-search-forward-continue ()
  "Continue search forward for match for `djvu-last-search-re'."
  (interactive)
  (djvu-re-search-forward djvu-last-search-re))

;; Fixme: New command `djvu-ispell-word' available in the read buffer.
;; To avoid re-inventing the wheel, this command should inherit some
;; functionality from `ispell-word'.  Unfortunately, the latter is a rather
;; monolithic function, making it difficult to adapt ispell to our needs.

(defun djvu-edit-word (bpos)
  "Edit word at buffer position BPOS."
  (interactive "d")
  (let* ((old (buffer-substring-no-properties
               (djvu-property-beg bpos 'word)
               (djvu-property-end bpos 'word)))
         (new (read-string (format "Replace `%s' with: " old) old
                           nil nil djvu-inherit-input-method))
         (dpos (djvu-read-dpos bpos)))
    (with-current-buffer (djvu-ref text-buf)
      ;; As we operate in the raw text buffer, we need to translate
      ;; OLD and NEW into the raw format using `prin1-to-string'.
      (unless (and (djvu-goto-dpos 'word dpos)
                   (progn
                     ;; `djvu-goto-dpos' puts us past the first quote
                     ;; Yet we want to replace this quote, too.
                     (backward-char)
                     (looking-at (regexp-quote (prin1-to-string old)))))
        (error "`%s' not found" old))
      (replace-match (prin1-to-string new) t t)))
  (djvu-save-text))

(defun djvu-split-word (bpos)
  "Split word at buffer position BPOS.
This command operates on the read buffer."
  (interactive "d")
  (let ((beg (djvu-property-beg bpos 'word))
        (dpos (djvu-read-dpos bpos)))
    (with-current-buffer (djvu-ref text-buf)
      (djvu-split-word-internal (djvu-goto-dpos 'word dpos)
                                (- bpos beg))))
  (djvu-save-text))

(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) (user-error "Point 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-dpos beg))
        (epos (djvu-read-dpos (1- end))))
    (with-current-buffer (djvu-ref text-buf)
      (djvu-merge-words-internal (djvu-goto-dpos 'word bpos)
                                 (djvu-goto-dpos 'word epos))))
  (djvu-save-text))

(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))
    (while (< (point) end)
      (push (read (current-buffer)) words)
      (unless (eq 'word (caar words))
        (error "Syntax error in raw text")))
    (delete-region beg (point))
    (let ((object (apply 'list 'word 0 0 0 0 (nreverse words))))
      (djvu-text-zone 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")
  ;; Sometimes we have bounding boxes that are screwed up (e.g., a bbox
  ;; for BEG that even includes END).  Then the following fails and we can
  ;; merely run `djvu-merge-lines-internal' in the text buffer.
  (let ((bpos (djvu-read-dpos beg))
        (epos (djvu-read-dpos (1- end))))
    (with-current-buffer (djvu-ref text-buf)
      (djvu-merge-lines-internal (djvu-goto-dpos 'word bpos)
                                 (djvu-goto-dpos 'word epos))))
  (djvu-save-text))

(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)
  (unless (looking-at "[ \t]*(word ")
    (re-search-backward "^[ \t]*(word "))
  (forward-sexp)
  (setq end (point))
  ;; Calculate proper value of BEG
  (goto-char beg)
  (unless (looking-at "[ \t]*(word ")
    (re-search-backward "^[ \t]*(word "))
  (skip-chars-forward " \t")
  (setq beg (point))
  (unless (< beg end) (user-error "Nothing to merge"))
  ;; The following fails if the zone levels of the lines we want to merge
  ;; are different.  For example:
  ;; (line X X X X
  ;;  (word X X X X string)
  ;;  (word X X X X string))
  ;; (para X X X X
  ;;  (line X X X X
  ;;   (word X X X X string)
  ;;   (word X X X X string)))
  (atomic-change-group
    (save-restriction
      (narrow-to-region beg end)
      (mapc (lambda (zone)
              (goto-char (point-min))
              (let ((re (format ")[\n\t\s]+(%s %s" zone djvu-coords-re)))
                (while (re-search-forward re nil t)
                  (replace-match ""))))
            '("column" "region" "para" "line"))
      ;; Check that we got what we want.
      (goto-char (point-min))
      (while (> (point-max) (progn (skip-chars-forward "\n\t\s") (point)))
        (if (looking-at "(word ")
            (forward-sexp) ; may signal `scan-error'
          (error "Syntax error: cannot merge"))))))

(defun djvu-init-text (object &optional doc reset)
  "Initialize Text buffer."
  (with-current-buffer (djvu-ref text-buf doc)
    (let ((dpos (unless reset (djvu-text-dpos nil doc)))
          buffer-read-only)
      (erase-buffer)
      (djvu-insert-text object "")
      (insert "\n")
      (if (not reset)
          (djvu-goto-dpos 'word dpos)
        (goto-char (point-min))
        (set-buffer-modified-p nil)
        (setq buffer-undo-list nil)))))

(defun djvu-insert-text (object indent)
  "Insert OBJECT into Djvu text buffer recursively using indentation INDENT."
  (when object
    (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))
          (insert (format " %S)" (car tail)))
        (dolist (elt tail)
          (insert "\n")
          (djvu-insert-text elt indent))
        (insert ")")))))

(defun djvu-text-dpos (&optional point doc)
  "Return Djvu position of POINT in Djvu text buffer."
  (with-current-buffer (djvu-ref text-buf doc)
    (save-excursion
      (if point (goto-char point))
      (beginning-of-line)
      (let (zone)
        (while (not (or (setq zone (looking-at djvu-zone-re))
                        (bobp)))
          (forward-line -1))
        (if zone
            (mapcar #'djvu-match-number '(3 4 5 6)))))))

(defun djvu-read-text (&optional doc)
  "Read text of a Djvu document from text buffer."
  (let (object)
    (with-current-buffer (djvu-ref text-buf doc)
      (save-excursion
        (save-restriction
          (widen)
          (goto-char (point-min))
          (unless (eobp)
            (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)"))))))
    object))

(defun djvu-save-text (&optional doc script)
  "Save text of the Djvu document DOC.  This updates the Read buffer for DOC.
DOC defaults to the current Djvu document.
If SCRIPT is non-nil, dump the text buffer into the djvused script file SCRIPT."
  (interactive)
  (unless doc (setq doc djvu-doc))
  (let ((object1 (djvu-read-text doc))
        (object2 (djvu-read-text doc))) ; true recursive copy of OBJECT1
    ;; Re-initializing the text buffer blows up the undo list of this buffer.
    ;; This step is only needed if we changed the text zones (e.g., when
    ;; merging lines).  So we check whether `djvu-text-zone' has changed
    ;; OBJECT.  For this, it is easier to read OBJECT twice than copying it
    ;; recursively.
    (djvu-text-zone object1 0 (make-vector 7 nil))
    (unless (equal object1 object2)
      (djvu-init-text object1 doc))
    ;; Update read buffer.  We do this even if the text buffer is not
    ;; modified, as we may have undone a change in the text buffer that
    ;; previously propagated also into the read buffer.  The Read buffer
    ;; has no undo list.
    (djvu-init-read object1 doc)
    ;; It is a bit of a hack to use this command for two rather different
    ;; purposes.  But we do not want to read OBJECT one more time.
    (if script
        (with-temp-buffer
          (setq buffer-file-coding-system 'utf-8)
          (insert (format "select %d\nremove-txt\nset-txt\n"
                          (djvu-ref page doc)))
          (djvu-insert-text object1 "")
          (insert "\n.\n") ; see djvused command set-txt
          (write-region nil nil script t 0))))) ; append to SCRIPT

(defun djvu-text-zone (object depth zones)
  "Evaluate ZONES for text OBJECT recursively.
This rearranges the tail of OBJECT destructively.
Branches of OBJECT that point to empty strings are removed."
  (if (stringp (nth 5 object))
      ;; We set ZONES only if we have something nontrivial
      (cond ((not (equal "" (nth 5 object)))
             (aset zones depth (vector (nth 1 object) (nth 2 object)
                                       (nth 3 object) (nth 4 object))))
            ((zerop depth)
             (setcdr object (list 0 0 0 0 ""))))
    (let ((depth1 (1+ depth))
          zone remove)
      (aset zones depth nil)
      (dolist (elt (nthcdr 5 object))
        (aset zones depth1 nil)
        (djvu-text-zone elt depth1 zones)
        (let ((zone1 (aref zones depth1)))
          (cond ((not zone1)
                 ;; ELT has no ZONE1 because it points to an empty string.
                 (push elt remove))
                ((setq zone (aref zones depth))
                 (aset zone 0 (min (aref zone 0) (aref zone1 0)))
                 (aset zone 1 (min (aref zone 1) (aref zone1 1)))
                 (aset zone 2 (max (aref zone 2) (aref zone1 2)))
                 (aset zone 3 (max (aref zone 3) (aref zone1 3))))
                (t (aset zones depth zone1)))))
      (if remove
          (let ((tail (nthcdr 4 object)))
            (dolist (elt remove)
              ;; `delq' removes all occurences of ELT from TAIL.
              (setcdr tail (delq elt (cdr tail))))))
      (cond ((setq zone (aref zones depth))
             (setcdr object (append (mapcar #'identity zone)
                                    (nthcdr 5 object))))
            ((zerop depth)
             (setcdr object (list 0 0 0 0 "")))
            (t
             (setcdr object nil))))))

(defun djvu-script-buffer (buffer)
  "Return buffer for djvu script.
t means current buffer, nil means `djvu-script-buffer'."
  (if (eq t buffer)
      (current-buffer)
    (get-buffer-create (or buffer djvu-script-buffer))))

(defun djvu-text-script (&optional doc buffer page display)
  "Create djvused script for complete text layer of DOC in BUFFER.
If prefix PAGE is non-nil create instead script for only page PAGE.
BUFFER defaults to `djvu-script-buffer'.  If BUFFER is t use current buffer.

You can edit the text script in BUFFER.  Afterwards you can re-apply
this script using `djvu-process-script'.  This code will not (cannot) check
whether the edited script is meaningful for DOC.  Use at your own risk.
You get what you want."
  (interactive (list nil nil (if current-prefix-arg (djvu-ref page)) t))
  (let ((doc (or doc djvu-doc))
        (buffer (djvu-script-buffer buffer)))
    (djvu-save doc t)
    ;; Put this in a separate buffer!
    (with-current-buffer buffer
      (let ((buffer-undo-list t)
            (djvu-init t)
            buffer-read-only)
        (djvu-script-mode)
        (erase-buffer)
        ;; Always create a self-contained djvused script.
        (if page (insert (format "select \"%s\" # page %d\n"
                                 (cdr (assq page (djvu-ref page-id doc)))
                                 page)))
        (djvu-djvused doc t "-e" (format "select %s; output-txt;"
                                         (or page "")))
        (goto-char (point-min)))
      (set-buffer-modified-p nil)
      (setq buffer-undo-list nil))
    (if display (switch-to-buffer buffer))))

(defun djvu-process-script (&optional doc buffer obey-restrictions)
  "For Djvu document DOC apply the djvused script in BUFFER.
Use at your own risk.  You get what you want.  This code does not (cannot)
check whether the script is meaningful.  Unless prefix OBEY-RESTRICTIONS
is non-nil, throw an error if BUFFER is narrowed.
DOC defaults to the current Djvu document.
BUFFER defaults to `djvu-script-buffer'.  If BUFFER is t, use current buffer."
  (interactive (list nil nil current-prefix-arg))
  (let ((doc (or doc djvu-doc)))
    (unless doc (user-error "No Djvu doc"))
    (djvu-save doc t)
    (djvu-with-temp-file script
      (with-current-buffer (djvu-script-buffer buffer)
        ;; If BUFFER is narrowed, we process only this part.
        (unless (or obey-restrictions
                    (equal (save-restriction ; not narrowed
                             (widen)
                             (- (point-max) (point-min)))
                           (- (point-max) (point-min))))
          (user-error "Script buffer narrowed"))
        (let ((buffer-file-coding-system 'utf-8))
          (write-region nil nil script nil 0)))
      (djvu-djvused doc nil "-f" script "-s"))
    ;; Redisplay
    (djvu-init-page nil doc)))

;;; Djvu Read mode

(defun djvu-init-read (object &optional doc reset)
  (with-current-buffer (djvu-ref read-buf doc)
    (let ((djvu-rect-list (djvu-ref rect-list doc))
          (dpos (unless reset (djvu-read-dpos nil doc)))
          buffer-read-only djvu-last-rect)
      (erase-buffer)
      (djvu-insert-read object)
      (djvu-insert-read-prop)
      (if reset
          (goto-char (point-min))
        (djvu-goto-read dpos)))
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)
    (if djvu-image-mode (djvu-image))))

(defun djvu-insert-read (object)
  "Display text OBJECT recursively."
  (let ((opoint (point))
        (tail (nthcdr 5 object)))
    (if (stringp (car tail))
        (progn
          (insert (car tail))
          ;; Propertize the read buffer according to `djvu-rect-list'
          (if djvu-rect-list
              (let (;; Try last rect first.
                    (rect-list (if djvu-last-rect
                                   (cons (nthcdr 2 djvu-last-rect) djvu-rect-list)
                                 djvu-rect-list))
                    ;; Center position of current object
                    (x (/ (+ (nth 1 object) (nth 3 object)) 2))
                    (y (/ (+ (nth 2 object) (nth 4 object)) 2))
                    rect coords found)
                (while (setq rect (pop rect-list))
                  (setq coords (car rect))
                  (when (and (< (nth 0 coords) x (nth 2 coords))
                             (< (nth 1 coords) y (nth 3 coords)))
                    (setq rect-list nil found t)
                    (if (equal (cdr rect) (nthcdr 3 djvu-last-rect))
                        (setq djvu-last-rect
                              (cons (car djvu-last-rect) (cons (point) rect)))
                      (djvu-insert-read-prop)
                      (setq djvu-last-rect
                            (cons opoint (cons (point) rect))))))
                (unless found
                  (djvu-insert-read-prop)))))
      (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) (insert sep)))))
    (put-text-property opoint (point) (car object)
                       (vector (nth 1 object) (nth 2 object)
                               (nth 3 object) (nth 4 object)))))

(defun djvu-insert-read-prop ()
  "Propertize Read buffer according to annotations."
  (when djvu-last-rect
    (let ((beg (nth 0 djvu-last-rect))
          (end (nth 1 djvu-last-rect))
          (face `(face (:background ,(nth 5 djvu-last-rect)
                        ;; `make-button' puts a `button' overlay
                        ;; that overrides :foreground.
                        :foreground ,(readable-foreground-color
                                      (nth 5 djvu-last-rect)))
                       help-echo ,(nth 4 djvu-last-rect))))
      (if (or (eq t djvu-read-prop-newline)
              (and (numberp djvu-read-prop-newline)
                   (save-excursion
                     (goto-char beg)
                     (re-search-forward "\n+" end t djvu-read-prop-newline))))
          (add-text-properties beg end face)
        (save-excursion
          (goto-char beg)
          (while (re-search-forward "[^\n]+" end t)
            (add-text-properties (match-beginning 0) (match-end 0) face))))
      (unless (equal "" (nth 3 djvu-last-rect))
        ;; Use `make-button' instead of `make-text-button' because a face
        ;; can hide a text button.
        (make-button beg end :type 'djvu-url
                     'help-echo (format "mouse-2, RET: url `%s'%s"
                                        (nth 3 djvu-last-rect)
                                        (if (equal "" (nth 4 djvu-last-rect))
                                            ""
                                          (format "\n%s" (nth 4 djvu-last-rect))))
                     'djvu-args (list (nth 3 djvu-last-rect)))))
    (setq djvu-last-rect nil)))

(defun djvu-read-dpos (&optional point doc)
  "Return Djvu position of POINT in Djvu Read buffer.
This is either a list (XMIN YMIN XMAX YMAX) or (X Y)."
  (with-current-buffer (djvu-ref read-buf doc)
    (cond ((and djvu-image-mode
                (djvu-ref read-pos doc)))
          ((= (point-min) (point-max))
           ;; An empty djvu page gives us something like (page 0 0 0 0 "")
           ;; Take the center of an empty page
           (list (/ (car (djvu-ref pagesize doc)) 2)
                 (/ (cdr (djvu-ref pagesize doc)) 2)))
          (t
           (unless point
             (setq point (point)))
           ;; Things get rather complicated if the text does not contain
           ;; separate words.
           (or (get-text-property point 'word)
               (and (< 1 point)
                    (get-text-property (1- point) 'word))
               ;; Search backward because more often
               ;; point is at the end of region we operated on
               (let ((pos (previous-single-property-change
                           point 'word)))
                 (and pos (get-text-property (1- pos) 'word)))
               (list (/ (car (djvu-ref pagesize doc)) 2)
                     (/ (cdr (djvu-ref pagesize doc)) 2)))))))

(defun djvu-mean-dpos (dpos)
  "For Djvu position DPOS return mean coordinates (X Y).
DPOS is a list or vector (XMIN YMIN XMAX YMAX)."
  (if (elt dpos 2)
      (list (/ (+ (elt dpos 0) (elt dpos 2)) 2)
            (/ (+ (elt dpos 1) (elt dpos 3)) 2))
    dpos))

(defsubst djvu-dist (width height)
  (+ (* width width) (* height height)))

(defun djvu-goto-dpos (object dpos)
  "Go to OBJECT at position DPOS in the text or annotation buffer.
If found, return corresponding buffer position.
Otherwise, do nothing and return nil."
  ;; This code relies on the fact that we have all coordinates
  ;; in the format (xmin ymin xmax ymax) instead of the format
  ;; (xmin ymin width height) used by djvused for maparea annotations.
  (cond ((not dpos) nil) ; DPOS is nil, do nothing, return nil

        ((elt dpos 2) ; DPOS is a list or vector (XMIN YMIN XMAX YMAX)
         (goto-char (point-min))
         (or (re-search-forward (format "\\<%s\\>[ \t\n]+%s\\([ \t\n]+\"\\)?"
                                        object
                                        (mapconcat #'number-to-string dpos
                                                   "[ \t\n]+"))
                                nil t)
             ;; try again, using the mean value of DPOS
             (djvu-goto-dpos object (djvu-mean-dpos dpos))))

        (t ; DPOS is a list (X Y)
         ;; Look for OBJECT with either
         ;; - DPOS inside OBJECT -> exact match
         ;; - OBJECT nearest to DPOS -> approximate match
         ;; The latter always succeeds.
         (let* ((re (format "\\<%s\\>[ \t\n]+%s\\([ \t\n]+\"\\)?"
                            object
                            (mapconcat #'identity
                                       (make-list 4 "\\([[:digit:]]+\\)")
                                       "[ \t\n]+")))
                (x (nth 0 dpos)) (y (nth 1 dpos))
                (x2 (- (* 2 x))) (y2 (- (* 2 y)))
                (good-dist (* 4 (djvu-dist (car (djvu-ref pagesize))
                                           (cdr (djvu-ref pagesize)))))
                (good-pnt (point-min))
                pnt dist)
           (goto-char (point-min))
           (while (and (not (zerop good-dist))
                       (setq pnt (re-search-forward re nil t)))
             (let ((xmin (djvu-match-number 1)) (ymin (djvu-match-number 2))
                   (xmax (djvu-match-number 3)) (ymax (djvu-match-number 4)))
               (if (and (<= xmin x xmax) (<= ymin y ymax))
                   (setq good-dist 0 good-pnt pnt) ; exact match
                 (setq dist (djvu-dist (+ xmin xmax x2) (+ ymin ymax y2)))
                 (if (< dist good-dist)
                     (setq good-pnt pnt good-dist dist))))) ; approximate match
           (goto-char good-pnt)
           (if (/= good-pnt (point-min)) good-pnt)))))

(defun djvu-goto-read (&optional dpos)
  "Go to buffer position in Read buffer corresponding to Djvu position DPOS.
Return corresponding buffer position."
  (with-current-buffer (djvu-ref read-buf)
    (cond (djvu-image-mode
           (djvu-set read-pos dpos)
           (point-min))
          ((not dpos) nil) ; DPOS is nil, do nothing, return nil

          ((elt dpos 2) ; DPOS is a list or vector (XMIN YMIN XMAX YMAX)
           ;; Go to the buffer position of the first word inside DPOS.
           (let ((pnt (point-min))
                 (xmin (elt dpos 0)) (ymin (elt dpos 1))
                 (xmax (elt dpos 2)) (ymax (elt dpos 3))
                 word done)
             (goto-char (point-min))
             (while (progn ; Do while
                      (setq done
                            (and (setq word (djvu-mean-dpos
                                             (get-text-property pnt 'word)))
                                 (<= xmin (nth 0 word) xmax)
                                 (<= ymin (nth 1 word) ymax)))
                      (and (not done)
                           (setq pnt (next-single-property-change pnt 'word)))))
             (if done
                 (goto-char pnt)
               ;; try again, using the mean value of DPOS
               (djvu-goto-read (djvu-mean-dpos dpos)))))

          (t ; DPOS is a list (X Y)
           ;; Look for word with either
           ;; - DPOS inside word -> exact match
           ;; - word nearest to DPOS -> approximate match
           ;; The latter always succeeds.
           (let* ((x (nth 0 dpos)) (y (nth 1 dpos))
                  (x2 (- (* 2 x))) (y2 (- (* 2 y)))
                  (good-dist (* 4 (djvu-dist (car (djvu-ref pagesize))
                                             (cdr (djvu-ref pagesize)))))
                  (pnt (point-min)) (good-pnt (point-min))
                  word dist)
             (goto-char (point-min))
             (while (progn ; Do while
                      (when (setq word (get-text-property pnt 'word))
                        (if (and (<= (aref word 0) x (aref word 2))
                                 (<= (aref word 1) y (aref word 3)))
                            (setq good-dist 0 good-pnt pnt) ; exact match
                          (setq dist (djvu-dist (+ (aref word 0) (aref word 2) x2)
                                                (+ (aref word 1) (aref word 3) y2)))
                          (if (< dist good-dist)
                              (setq good-pnt pnt good-dist dist)))) ; approximate match
                      (and (not (zerop good-dist))
                           (setq pnt (next-single-property-change pnt 'word)))))
             (goto-char good-pnt)
             (if (/= good-pnt (point-min)) good-pnt))))))

;;; Djvu Annotation mode

(defun djvu-init-annot (buf doc &optional shared)
  "Initialize Annotations buffer BUF of Djvu document DOC.
SHARED should be non-nil for a Shared Annotations buffer."
  (djvu-convert-hash)
  (goto-char (point-min))
  (let (object alist)
    (while (progn (skip-chars-forward " \t\n") (not (eobp)))
      (beginning-of-line)
      (if (looking-at djvu-beg-object-re)
          (push (read (current-buffer)) object)
        (error "Unknown annotation `%s'" (buffer-substring-no-properties
                                          (point) (line-end-position)))))

    (dolist (elt object)
      (if (not (eq 'maparea (car elt)))
          (push elt alist)
        ;; To simplify the editing of annotations, identify rect mapareas
        ;; sharing the same text string.
        (cond ((eq 'rect (car (nth 3 elt))) ; rect
               (let ((area (djvu-area (nth 3 elt)))
                     e)
                 ;; Remove area destructively.
                 (setcdr (nthcdr 2 elt) (nthcdr 4 elt))
                 ;; The new elements of alist are cons cells, where the car
                 ;; is the maparea without area, and the cdr is the list
                 ;; of areas.  Even if we have just an empty string,
                 ;; we still want to massage the area.
                 (if (or (string= "" (nth 2 elt))
                         (not (setq e (assoc elt alist))))
                     (push (cons elt (list area)) alist)
                   (setcdr e (cons area (cdr e))))))
              ((memq (car (nth 3 elt)) '(text oval)) ; mapareas text, oval
               (setcar (nthcdr 3 elt) (djvu-area (nth 3 elt)))
               (push elt alist))
              (t (push elt alist)))))

    (unless shared
      (let ((id 0) rect-list)
        (dolist (elt alist)
          (when (consp (car elt)) ; maparea rect and oval
            (setq id (1+ id))
            (push (djvu-rect-elt elt id) rect-list)))
        (djvu-set rect-list (apply 'nconc rect-list) doc)))

    ;; Pretty print annotations.
    (with-current-buffer buf
      (let ((standard-output (current-buffer))
            buffer-read-only)
        (erase-buffer)
        (dolist (elt alist)
          (cond ((consp (car elt)) ; maparea with list of areas
                 (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 and oval
                           (mapconcat #'prin1-to-string (nthcdr 3 c) " ") ; rest
                           ")")))
                ((eq 'metadata (car elt)) ; metadata
                 (insert "(metadata")
                 (dolist (entry (cdr elt))
                   (insert (format "\n (%s %S)" (car entry) (cadr entry))))
                 (insert ")"))
                ((not (eq 'maparea (car elt))) ; no maparea
                 (prin1 elt))
                ((memq (car (nth 3 elt)) '(text oval line poly)) ; maparea text, oval, line, poly
                 (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-convert-hash t))
      (goto-char (point-min))
      (set-buffer-modified-p nil)
      (setq buffer-undo-list nil))))

(defun djvu-rect-elt (rect id)
  "For rect RECT define entry for `djvu-rect-list' using ID."
  (let* ((maparea (car rect))
         (url (nth 1 maparea))
         (text (nth 2 maparea))
         (color (djvu-color-background
                 (cond ((nth 1 (assoc 'hilite maparea))) ; Use color if possible.
                       (url djvu-color-url) ; we have a URL
                       (t djvu-color-highlight))
                 nil
                 (or (nth 1 (assoc 'opacity maparea))
                     djvu-opacity))))
    ;; If multiple annotations differ only in the AREAs, it is assumed
    ;; that they belong together, so that they are collapsed in the
    ;; annotations buffer and their text properties in the Read buffer
    ;; are merged across word boundaries.  This is usually OK when URL
    ;; and TEXT are non-empty strings.  But we do not collapse such entries
    ;; in the annotations buffer if URL and TEXT are empty strings.
    ;; To achieve the same with text properties in the Read buffer, we add
    ;; the extra element ID to the elements of `djvu-rect-list'.
    (mapcar (lambda (area)
              (list (cdr area) url text color id))
            (cdr rect))))

(defun djvu-font-lock-url (bound)
  (let ((pnt (point)) case-fold-search found beg end)
    (cond ((memq djvu-buffer '(annot shared))
           (beginning-of-line)
           (while (and (not found)
                       (re-search-forward "^[ \t]*(maparea" bound t))
             (setq found (and (looking-at "[ \t]*\"")
                              (progn
                                (setq beg (match-end 0))
                                (>= beg pnt))
                              (<= beg bound)
                              (progn
                                (forward-sexp)
                                (setq end (1- (point))))))))
          ((eq djvu-buffer 'bookmarks)
           (re-search-backward "^[ \t]*(" nil t)
           (while (and (not found)
                       (re-search-forward "^[ \t]*(" bound t))
             (setq found (and (looking-at "[ \t]*\"")
                              (progn
                                (forward-sexp)
                                (looking-at "[ \t\n]+\""))
                              (progn
                                (setq beg (match-end 0))
                                (>= beg pnt))
                              (<= beg bound)
                              (progn
                                (forward-sexp)
                                (setq end (1- (point)))))))))
    (when found
      (remove-text-properties beg end '(face))
      (make-text-button beg end 'type 'djvu-url
                        'djvu-args (list (buffer-substring-no-properties beg end))))
    found))

(defun djvu-button-action (button)
  "Call BUTTON's Djvu function."
  (apply (button-get button 'djvu-function)
         (button-get button 'djvu-args)))

(define-button-type 'djvu-url
  'action 'djvu-button-action
  'djvu-function 'djvu-url
  'help-echo "mouse-2, RET: follow URL")

(defun djvu-url (url)
  "Browse URL in Djvu document.
If URL is an internal url, go to that page."
  (if (string-match "\\`#" url)
      (let* ((page-url (substring url 1))
             (page (or (car (rassoc page-url (djvu-ref page-id)))
                       (and (string-match "\\`[0-9]+\\'" page-url)
                            (string-to-number page-url)))))
        (unless page (error "Invalid internal url `%s'" page-url))
        (djvu-goto-page page)
        (djvu-switch-read))
    (browse-url url)))

;; Djvused maparea `text'
(defun djvu-interactive-text-area (&optional border backclr textclr pushpin)
  "Interactive spec for `djvu-text-area' and friends."
  (let ((dpos (djvu-mean-dpos (djvu-read-dpos)))
        (pagesize (djvu-ref pagesize))
        (color (djvu-interactive-color djvu-color-highlight)))
    (list nil (read-string (format "(%s) Text: " (or color "no color"))
                           nil nil nil djvu-inherit-input-method)
          (list (nth 0 dpos) (nth 1 dpos)
                (+ (nth 0 dpos) (/ (car pagesize) 2))
                (+ (nth 1 dpos) (/ (cdr pagesize) 30)))
          border
          (or backclr (djvu-color-background color))
          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-bound-area (area &optional doc)
  "Restrict AREA to page boundaries."
  (unless doc (setq doc djvu-doc))
  ;; AREA may be a list or vector.  Always return a list.
  (list (max 1 (min (elt area 0) (car (djvu-ref pagesize doc))))
        (max 1 (min (elt area 1) (cdr (djvu-ref pagesize doc))))
        (max 1 (min (elt area 2) (car (djvu-ref pagesize doc))))
        (max 1 (min (elt area 3) (cdr (djvu-ref pagesize doc))))))

(defun djvu-text-area (url comment area
                           &optional border backclr textclr pushpin)
  "Using strings URL and COMMENT, highlight AREA.
This defines a text maparea for djvused.
AREA is a list (XMIN YMIN XMAX YMAX).
Interactively, the command `djvu-mouse-text-area' in `djvu-image-mode'
is usually easier to use."
  (interactive (djvu-interactive-text-area))
  (setq area (djvu-bound-area area))
  (with-current-buffer (djvu-ref annot-buf)
    (goto-char (point-max))
    (insert (format "(maparea %S\n %S\n "
                    (or url "") (if comment (djvu-fill comment) ""))
            (apply 'format "(text %d %d %d %d)" area)
            (format " (%s)" (or border 'none))
            (if backclr (djvu-insert-color "backclr" backclr) "")
            (if textclr (djvu-insert-color "textclr" textclr) "")
            (if pushpin " (pushpin)" "")
            ")\n\n")
    (undo-boundary)))

(defun djvu-text-area-pushpin (url comment area
                                   &optional border backclr textclr pushpin)
  "Using URL and COMMENT, highlight AREA as pushpin.
This defines a rect area for djvused.
Interactively, the command `djvu-mouse-text-area-pushpin' in `djvu-image-mode'
is usually easier to use."
  (interactive (djvu-interactive-text-area nil nil nil t))
  (djvu-text-area url comment area border backclr textclr pushpin))

(defun djvu-mark-line-beg (pnt comment &optional left color)
  "Mark word at beginning of line.
With prefix LEFT mark left of beginning of line."
  (interactive
   (let ((prefix current-prefix-arg))
     (list (line-beginning-position)
           (read-string (format "(%s) %sMarker comment: "
                                djvu-color-himark
                                (if prefix "left " ""))
                        nil nil nil djvu-inherit-input-method)
           prefix djvu-color-himark)))
  (let* ((zone (get-text-property pnt 'word))
         (height (- (aref zone 3) (aref zone 1)))
         (xmin (- (aref zone 0) (round (* 2.5 height)))))
    (if left
        (djvu-text-area nil comment
                        (list xmin (aref zone 1)
                              (- (aref zone 0) (/ height 2)) (aref zone 3))
                        nil
                        (djvu-color-background color))
      (djvu-rect-area nil comment
                      `((,xmin ,(aref zone 1) ,(aref zone 2) ,(aref zone 3)))
                      color djvu-opacity))))

;; Djvused maparea `rect'
(defun djvu-himark (bookmark url beg end comment
                             &optional level color opacity border)
  ;; Fixme: Fix docstring.
  "Bookmark and highlight the region between BEG and END."
  (interactive
   (djvu-with-region region
     (let ((level (djvu-interactive-bookmark-level)) ; handle prefix arg first
           (bookmark (djvu-read-string "Bookmark: " region t)))
       (list bookmark (djvu-ref page) (car region) (cdr region) bookmark level
             djvu-color-himark djvu-opacity nil))))
  (djvu-bookmark bookmark url level)
  (djvu-rect-region beg end nil comment color opacity border))

(defun djvu-update-url (url &optional color opacity border)
  "Update URL"
  (interactive
   (let* ((color (djvu-interactive-color djvu-color-url))
          (url (djvu-interactive-url color)))
     (list url color djvu-opacity 'xor)))
  (let ((dpos (djvu-dpos))
        (doc djvu-doc))
    (with-current-buffer (djvu-ref annot-buf doc)
      (if (djvu-goto-dpos 'rect dpos)
          (djvu-update-url-internal url color opacity border)
        (user-error "No object to update")))))

(defun djvu-update-url-internal (url &optional color _opacity border)
  "Update URL internal."
  (interactive
   (let* ((color (djvu-interactive-color djvu-color-url))
          (url (djvu-interactive-url color)))
     (list url color djvu-opacity 'xor)))
  (let ((bounds (djvu-object-bounds)))
    (if bounds
        (save-excursion
          (save-restriction
            (narrow-to-region (car bounds) (cdr bounds))
            (goto-char (point-min))
            (if (not (looking-at "(maparea \\(\"[^\"]*\"\\)"))
                (user-error "Nothing to update")
              (replace-match (format "\"%s\"" url) nil nil nil 1)
              (djvu-update-color-internal color)
              (goto-char (point-min))
              (let ((border (format "(%s)" border)))
                (if (re-search-forward "(\\(none\\|xor\\))" nil t)
                    (replace-match border)
                  (goto-char (point-max))
                  (skip-chars-backward " \t\n")
                  (backward-char) ; skip closing ")"
                  (insert " " border)))))))))

(defun djvu-rect-region-url (beg end url comment &optional color opacity border)
  "Put URL over region between BEG and END, adding annotation COMMENT."
  ;; Same as `djvu-rect-region', but it also adds the url field
  (interactive
   (djvu-with-region region
     (let* ((color (djvu-interactive-color djvu-color-url))
            (url (djvu-interactive-url color))
            (comment (djvu-read-string
                      (format "(%s, %s) Annotation: "
                              url (or color "no color"))
                      region)))
       (list (car region) (cdr region) url comment color djvu-opacity 'xor))))
  (djvu-rect-region beg end url comment color opacity border))

(defun djvu-rect-region (beg end url comment &optional color opacity border)
  "Highlight region between BEG and END, add URL and annotation COMMENT."
  (interactive
   (djvu-with-region region
     (let* ((color (djvu-interactive-color djvu-color-highlight))
            (comment (djvu-read-string (format "(%s) Annotation: "
                                               (or color "no color"))
                                       region)))
       (list (car region) (cdr region) nil comment color djvu-opacity 'none))))

  (unless (get-text-property beg 'word)
    (user-error "Start position `%s' not a word" beg))
  (unless (get-text-property (1- end) 'word)
    (user-error "End position `%s' not a word" end))
  (let ((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))
        areas)
    (unless (and (>= 1 paras) (>= 1 regions) (>= 1 columns))
      (user-error "Region spans multiple paragraphs"))

    (if (eq 1 lines)
        (setq areas (list (djvu-scan-zone beg end 'word)))

      (if (eq 2 lines)
          (let ((c1 (djvu-scan-zone beg (djvu-property-end (1+ beg) 'line) 'word))
                (c2 (djvu-scan-zone (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-areas-justify t c1 c2))
                (djvu-justify-areas '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-areas-justify nil c2 c1))
                (djvu-justify-areas '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 areas (list c1 c2)))
        ;; 3 lines
        (let* ((l1e (djvu-property-end (1+ beg) 'line))
               (l2b (djvu-property-beg (1- end) 'line))
               (c1  (djvu-scan-zone beg l1e 'word))
               (ci  (djvu-scan-zone (1+ l1e) (1- l2b) 'line))
               (c2  (djvu-scan-zone 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-areas-justify t c1 ci c2))
                 (djvu-justify-areas 'min 0 c1 ci c2))
                ((djvu-areas-justify t ci c2)
                 (djvu-justify-areas '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-areas-justify nil c2 ci c1))
                 (djvu-justify-areas 'max 2 c1 ci c2))
                ((djvu-areas-justify nil c1 ci)
                 (djvu-justify-areas '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 areas (list c1 ci c2)))))

    (djvu-rect-area url comment areas color opacity border)))

(defun djvu-merge-areas (areas)
  "Try to merge elements in AREAS.
This assumes that element N in AREAS is above element N+1.
If such a pair of elements has the same left and right boundaries,
and the lower boundary of N equals the upper boundary of N+1,
these elements are merged into one."
  (let ((areas areas))
    (while (nth 1 areas)
      (let ((c0 (nth 0 areas)) (c1 (nth 1 areas)))
        (if (and (eq (aref c0 0) (aref c1 0))
                 (eq (aref c0 2) (aref c1 2))
                 (eq (aref c0 1) (aref c1 3)))
            (progn (aset c0 1 (aref c1 1))
                   (setcdr areas (cddr areas)))
          (pop areas)))))
  areas)

(defun djvu-rect-area (url comment rects &optional color opacity border)
  "Using URL and COMMENT, highlight RECTS.
The elements in the list RECTS are 4-element sequences of coordinates
each defining a rect area for djvused."
  (setq rects (mapcar (lambda (rect) (apply 'format "(rect %d %d %d %d)"
                                            (djvu-bound-area rect)))
                      (djvu-merge-areas rects)))
  ;; Insert in Annotations buffer.
  (with-current-buffer (djvu-ref annot-buf)
    (unless (and djvu-rect-area-nodups
                 (save-excursion
                   (goto-char (point-min))
                   (re-search-forward (mapconcat #'identity rects "[ \t\n]*")
                                      nil t)))
      (goto-char (point-max))
      (insert (format "(maparea %S\n %S\n ("
                      (or url "") (if comment (djvu-fill comment) ""))
              (mapconcat #'identity rects "\n  ")
              ")\n"
              (djvu-insert-color "hilite" color)
              (if (and color opacity) (format " (opacity %s)" opacity) "")
              (format " (%s)" (or border 'none))
              ")\n\n")
      (undo-boundary))))

(defun djvu-fill (text)
  "Fill string TEXT using `fill-column' of the annotations buffer.
This value of `fill-column' defaults to `djvu-fill-column'."
  (let ((fcolumn (with-current-buffer (djvu-ref annot-buf)
                   fill-column)))
    (with-temp-buffer
      (insert text)
      (let ((fill-column fcolumn))
        (fill-region (point-min) (point-max)))
      (buffer-substring-no-properties
       (point-min) (point-max)))))

(defun djvu-toggle-rect-text-internal ()
  "Toggle between Mapareas rect and text."
  (interactive)
  (let ((bounds (djvu-object-bounds))
        (rect-re (format "(rect[\s\t]+%s)" djvu-coords-re))
        (text-re (format "(text[\s\t]+%s)" djvu-coords-re))
        (color-re (format djvu-color-re "#" "" "")))
    (if (not bounds)
        (user-error "No object to update")
      (save-excursion
        (save-restriction
          (narrow-to-region (car bounds) (cdr bounds))
          (goto-char (point-min))

          (cond ((re-search-forward rect-re nil t) ; Maparea rect
                 (if (save-match-data (re-search-forward rect-re nil t))
                     (user-error "Only single rect can be converted to text"))
                 (replace-match (format "text %s" (match-string 2)))
                 (goto-char (point-min))
                 (let ((opacity
                        (if (re-search-forward " *(opacity \\([0-9]+\\))" nil t)
                            (prog1 (djvu-match-number 1)
                              (replace-match ""))
                          djvu-opacity)))
                   (goto-char (point-min))
                   ;; Loop over matches of COLOR-RE as this general regexp
                   ;; also matches elements that so far we do not care about.
                   (while (re-search-forward color-re nil t)
                     (if (equal (match-string 1) "hilite")
                         (replace-match
                          (format "(backclr %s)"
                                  (save-match-data
                                    (djvu-color-background
                                     (match-string 2) nil opacity))))))))

                ((re-search-forward text-re nil t) ; Maparea text
                 ;; Only with maparea text we want to query the opacity.
                 ;; Putting this into the interactive spec would require
                 ;; to duplicate the job.
                 (let ((opacity (save-match-data
                                  (read-number "Opacity: " djvu-opacity))))
                   (replace-match (format "((rect %s))" (match-string 2)))
                   (goto-char (point-min))
                   ;; Loop over matches of COLOR-RE as this general regexp
                   ;; also matches elements that so far we do not care about.
                   (while (re-search-forward color-re nil t)
                     (if (equal (match-string 1) "backclr")
                         (replace-match
                          (format "(hilite %s) (opacity %d)"
                                  (save-match-data
                                    (djvu-color-background
                                     (match-string 2) nil opacity t))
                                  opacity))))))
                (t
                 (user-error "Nothing to toggle"))))))))

(defun djvu-resize-internal (step)
  "Resize Djvu mapareas rect and text by STEP."
  (interactive "nStep: ")
  (let ((bounds (djvu-object-bounds)))
    (if (not bounds)
        (user-error "No object to update")
      (save-excursion
        (save-restriction
          (narrow-to-region (car bounds) (cdr bounds))
          (goto-char (point-min))
          (while (re-search-forward djvu-area-re nil t)
            (if (string= "poly" (match-string 1))
                (user-error "Cannot resize maparea poly"))
            (replace-match (format "%d %d %d %d"
                                   (- (djvu-match-number 3) step)
                                   (- (djvu-match-number 4) step)
                                   (+ (djvu-match-number 5) step)
                                   (+ (djvu-match-number 6) step))
                             nil nil nil 2)))))))

(defun djvu-shift-internal (shiftx shifty &optional all scale)
  "Shift Djvu mapareas rect and text by SHIFTX and SHIFTY.
With prefix ALL non-nil shift all mapareas of current page."
  (interactive
   (let ((shift (mapcar #'string-to-number
                        (split-string (read-string "Shiftx, shifty: ")
                                      "[\t\s\n,;]+" t "[\t\s\n]"))))
     (list (nth 0 shift) (nth 1 shift) current-prefix-arg)))
  (unless (numberp scale) (setq scale 1))
  (save-excursion
    (save-restriction
      (unless all
        (let ((bounds (djvu-object-bounds)))
          (if bounds
              (narrow-to-region (car bounds) (cdr bounds))
            (user-error "No object to update"))))
      (goto-char (point-min))
      ;; FIXME: provide alternative regexp for text buffer.
      ;; FIXME: honor page boundaries:
      ;; Cut off visible areas, drop invisble areas (with warning?)
      (while (re-search-forward djvu-area-re nil t)
        (replace-match (format "%d %d %d %d"
                               (+ (* (djvu-match-number 3) scale) shiftx)
                               (+ (* (djvu-match-number 4) scale) shifty)
                               (+ (* (djvu-match-number 5) scale) shiftx)
                               (+ (* (djvu-match-number 6) scale) shifty))
                       nil nil nil 2)
        (if (string= "poly" (match-string 1))
            (while (progn (skip-chars-forward "\s\t\n")
                          (looking-at djvu-coord-xy-re))
              (replace-match (format "%d %d"
                                     (+ (* (djvu-match-number 1) scale) shiftx)
                                     (+ (* (djvu-match-number 2) scale) shifty)))))))))

(defun djvu-remove-linebreaks-internal ()
  "Remove linebreaks in Maparea string.
This may come handy for reformatting such strings."
  (interactive)
  (let ((bounds (djvu-object-bounds)))
    (if (not bounds)
        (user-error "No object to update")
      (save-excursion
        (goto-char (car bounds))
        ;; Skip over maparea and url
        (forward-char)
        (forward-sexp 2)
        (skip-chars-forward "\s\t\n")
        (save-restriction
          (narrow-to-region (point) (scan-sexps (point) 1))
          (while (re-search-forward "\n\\(\n\\)*" nil t)
            (unless (match-string 1)
              (replace-match " "))))))))

;; The functions `djvu-property-beg' and `djvu-property-end' rely on the fact
;; that regions with property PROP are always surrounded by at least one
;; character without property PROP.  Repeated calls of `djvu-property-beg'
;; and `djvu-property-end' thus never go beyond this region.
(defun djvu-property-beg (pnt prop)
  "Starting from position PNT search backward for beginning of property PROP.
Return position found."
  (let ((p1 (get-text-property pnt prop)) pnt-1)
    (cond ((and p1 (< (point-min) pnt)
                (eq p1 (get-text-property (1- pnt) prop)))
           (previous-single-property-change pnt prop nil (point-min)))
          (p1 pnt)
          ((and (< (point-min) pnt)
                (setq p1 (get-text-property (setq pnt-1 (1- pnt)) prop)))
           ;; PNT is at the end position for property PROP
           (if (and (< (point-min) pnt-1)
                    (eq p1 (get-text-property (1- pnt-1) prop)))
               (previous-single-property-change pnt-1 prop nil (point-min))
             pnt-1))
          (t (error "Position %s does not have/end property %s" pnt prop)))))

(defun djvu-property-end (pnt prop)
  "Starting from position PNT search forward for end of property PROP.
Return position found."
  (let ((p1 (get-text-property pnt prop)))
    (cond ((and p1 (< pnt (point-max))
                (eq p1 (get-text-property (1+ pnt) prop)))
           (next-single-property-change pnt prop nil (point-max)))
          (p1 (1+ pnt))
          ((and (< (point-min) pnt)
                (get-text-property (1- pnt) prop))
           ;; We had PNT at the end position for property PROP
           pnt)
          (t (error "Position %s does not have/end property %s" pnt prop)))))

(defun djvu-areas-justify (left &rest ci)
  "Return non-nil if areas 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-areas-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-areas (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-zone (beg end prop)
  "Between BEG and END calculate total zone coordinates for PROP."
  ;; Assume that BEG has PROP.
  (let* ((zone (copy-sequence (get-text-property beg prop)))
         (max (aref zone 1))
         (min (aref zone 3))
         (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 zone 0 (min (aref zone 0) (aref val 0)))
        (aset zone 1 (min (aref zone 1) (aref val 1)))
        (setq max (max max (aref val 1))) ; descending words
        (aset zone 2 (max (aref zone 2) (aref val 2)))
        (aset zone 3 (max (aref zone 3) (aref val 3)))
        (setq min (min min (aref val 3))))) ; ascending words

    ;; The following is rather heuristic.  Suggestions for better
    ;; solutions welcome, though probably not worth the effort.
    ;; Set `djvu-descenders-re' to nil if you do not like this.
    (if (and (or djvu-descenders-re djvu-ascenders-re)
             (eq prop 'word))
        (let* ((string (buffer-substring-no-properties beg end))
               (long (< 1 (length string))) ; not a single-character string
               case-fold-search)
          (if (and long djvu-descenders-re
                   ;; descending words
                   (> 0.10 (/ (- max (aref zone 1))
                              (float (- (aref zone 3) (aref zone 1)))))
                   ;; all-uppercase string
                   (not (string= string (upcase string)))
                   ;; descender characters
                   (not (string-match djvu-descenders-re string)))
              (aset zone 1 (- (aref zone 1)
                              (round (* 0.20 (- (aref zone 3) (aref zone 1)))))))
          (if (and long djvu-ascenders-re
                   ;; ascending words
                   (> 0.10 (/ (- (aref zone 3) min)
                              (float (- (aref zone 3) (aref zone 1)))))
                   ;; ascender characters
                   (not (string-match djvu-ascenders-re string)))
              (aset zone 3 (+ (aref zone 3)
                              (round (* 0.20 (- (aref zone 3) (aref zone 1)))))))))
    zone))

(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-read-annot (buf)
  "Read annotations of a Djvu document from annotations buffer."
  (let (object)
    (with-current-buffer buf
      (save-restriction
        (widen)
        (with-temp-buffer
          (insert-buffer-substring-no-properties buf)
          (djvu-convert-hash)
          (goto-char (point-min))
          (while (progn (skip-chars-forward " \t\n") (not (eobp)))
            (beginning-of-line)
            (if (looking-at djvu-beg-object-re)
                (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))))))))
    (nreverse object)))

(defun djvu-save-annot (script &optional doc shared)
  "Save annotations of the Djvu document DOC.
This dumps the content of DOC's annotations buffer into the djvused script
file SCRIPT.  DOC defaults to the current Djvu document."
  (unless doc (setq doc djvu-doc))
  (let ((object (djvu-read-annot (if shared
                                     (djvu-ref shared-buf doc)
                                   (djvu-ref annot-buf doc)))))
    (dolist (elt object)
      (if (eq 'maparea (car elt))
          ;; URL
          (setcar (cdr elt) (djvu-resolve-url (nth 1 elt)))))

    (with-temp-buffer
      (let ((standard-output (current-buffer))
            (buffer-file-coding-system 'utf-8)
            (id 0)
            rect-list)
        (insert (if shared
                    "create-shared-ant; remove-ant; set-ant\n"
                  (format "select %d; remove-ant; set-ant\n"
                          (djvu-ref page doc))))
        (dolist (elt object)
          (cond ((eq 'metadata (car elt)) ; metadata
                 (prin1 elt)
                 (insert "\n"))
                ((or (not (eq 'maparea (car elt))) ; not maparea
                     (memq (car (nth 3 elt)) '(line poly))) ; maparea line, poly
                 (prin1 elt)
                 (insert "\n"))
                ((consp (car (nth 3 elt))) ; maparea rect
                 (dolist (area (nth 3 elt))
                   (insert (prin1-to-string
                            (apply 'list (car elt) (nth 1 elt) (nth 2 elt)
                                   (djvu-area area t) (nthcdr 4 elt)))
                           "\n"))
                 (setq id (1+ id))
                 (push (djvu-rect-elt
                        ;; `djvu-rect-elt' expects that the rect areas are at
                        ;; the end.
                        (cons (append (list (nth 0 elt) (nth 1 elt) (nth 2 elt))
                                      (nthcdr 4 elt))
                              (nth 3 elt))
                        id)
                       rect-list))
                ((memq (car (nth 3 elt)) '(text oval)) ; maparea text, oval
                 (insert (prin1-to-string
                          (apply 'list (car elt) (nth 1 elt) (nth 2 elt)
                                 (djvu-area (nth 3 elt) t)
                                 (nthcdr 4 elt)))
                         "\n"))
                (t (error "Djvu maparea %s undefined" (car (nth 3 elt))))))
        (insert ".\n")
        (djvu-convert-hash t)
        (write-region nil nil script t 0) ; append to SCRIPT
        ;; It is not all correct to ignore rect-list for shared
        ;; annotations.  It should really go into a separate variable
        ;; `djvu-doc-shared-rect-list', so that then we can merge
        ;; these for all pages.
        (unless shared
          (djvu-set rect-list (apply 'nconc rect-list) doc))))))

(defun djvu-annot-script (&optional doc buffer page display)
  "Create djvused script for complete annotation layer of DOC in BUFFER.
If prefix PAGE is non-nil create instead script for only page PAGE.
BUFFER defaults to `djvu-script-buffer'.  If BUFFER is t use current buffer.

You can edit the annotations script in BUFFER.  Afterwards you can re-apply
this script using `djvu-process-script'.  This code will not (cannot) check
whether the edited script is meaningful for DOC.  Use at your own risk.
You get what you want."
  (interactive (list nil nil (if current-prefix-arg (djvu-ref page)) t))
  (let ((doc (or doc djvu-doc))
        (buffer (djvu-script-buffer buffer)))
    (djvu-save doc t)
    ;; Put this in a separate buffer!
    (with-current-buffer buffer
      (let ((buffer-undo-list t)
            (djvu-init t)
            buffer-read-only)
        (djvu-script-mode)
        (erase-buffer)
        ;; Always create a self-contained djvused script.
        (if page (insert (format "select \"%s\" # page %d\n"
                                 (cdr (assq page (djvu-ref page-id doc)))
                                 page)))
        (djvu-djvused doc t "-e" (format "select %s; output-ant;"
                                         (or page "")))
        (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 buffer))))

(defun djvu-annot-dpos (&optional point doc)
  "Return Djvu position of POINT in Djvu annotations buffer."
  (with-current-buffer (djvu-ref annot-buf doc)
    (save-excursion
      (if point (goto-char point))
      (let ((bounds (djvu-object-bounds)))
        (if bounds
            (let* ((object (djvu-object bounds))
                   (area (nth 3 object)))
              (if (eq (car object) 'maparea)
                  (cond ((memq (car area) '(text oval line poly))
                         (cdr (nth 3 object)))
                        ((consp area) ; maparea rect
                         (cdar area))))))))))

;;; Manipulate annotations

(defun djvu-object-bounds ()
  "Return bounds (BEG . END) of Djvu object that contains or follows point.
Return nil if no such object can be found."
  (save-excursion
    (let ((pnt (point)) found end)
      (beginning-of-line)
      (while (not (or (setq found (looking-at djvu-beg-object-re))
                      (bobp)))
        (forward-line -1))
      (if (and found
               (< pnt (setq end (save-excursion (forward-sexp) (point)))))
          (cons (point) end)
        (setq found nil)
        (goto-char pnt)
        (while (not (or (setq found (looking-at djvu-beg-object-re))
                        (eobp)))
          (forward-line 1))
        (if found
            (cons (point) (progn (forward-sexp) (point))))))))

(defun djvu-object (bounds)
  "Return Djvu object defined via BOUNDS, a cons cell (BEG . END)."
  ;; We cannot call `read' in a Djvu buffer because the Djvu hash syntax
  ;; is not compatible with the Emacs read syntax.
  (let ((string (buffer-substring-no-properties (car bounds) (cdr bounds))))
    (with-temp-buffer
      (insert string)
      (djvu-convert-hash)
      (goto-char (point-min))
      (read (current-buffer)))))

(defun djvu-update-color (color)
  "Update color attribute of Djvu maparea to COLOR."
  (interactive (list (djvu-interactive-color-read)))
  (let ((dpos (djvu-dpos))
        (doc djvu-doc))
    (with-current-buffer (djvu-ref annot-buf doc)
      (if (djvu-goto-dpos 'rect dpos)
          (djvu-update-color-internal color)
        (user-error "No object to update")))))

(defun djvu-update-color-internal (color &optional opacity)
  "Update color attribute of Djvu maparea to COLOR.
If no such attribute exists insert a new one.
Prefix arg OPACITY is the opacity to use."
  (interactive
   (let ((color (djvu-interactive-color-read)))
     (list color
           (if (and color current-prefix-arg)
               (read-number "Opacity: ")))))
  (let ((bounds (djvu-object-bounds))
        (opacity (or opacity djvu-opacity)))
    (if bounds
        (save-excursion
          (goto-char (car bounds))
          (cond ((not color)
                 ;; remove color and opacity attributes
                 (when (re-search-forward
                        (format djvu-color-re "#" "" "") (cdr bounds) t)
                   (replace-match "")
                   (if (looking-at "[\s\t\n]+") (replace-match "")))
                 (goto-char (car bounds))
                 (when (re-search-forward "(opacity [0-9]+)" (cdr bounds) t)
                   (replace-match "")
                   (if (looking-at "[\s\t\n]+") (replace-match ""))))
                ((re-search-forward
                  (format djvu-color-re "#" "" "") (cdr bounds) t)
                 ;; update existing color attribute
                 (let ((attr (match-string 1)))
                   (cond ((member attr '("hilite" "lineclr" "border"))
                          (replace-match (cdr (assoc color djvu-color-alist))
                                         nil nil nil 2))
                         ((string= attr "backclr")
                          (replace-match (save-match-data
                                          (djvu-color-background color nil opacity))
                                         nil nil nil 2))
                         (t (message "Color update for attribute `%s' undefined"
                                     attr)))))
                ;; insert new color attribute (dependent on area attribute)
                ((re-search-forward "(rect" (cdr bounds) t)
                 (goto-char (1- (cdr bounds)))
                 (insert (format " (hilite %s)"
                                 (cdr (assoc color djvu-color-alist))))
                 (unless (save-excursion
                           (goto-char (car bounds))
                           (re-search-forward "(opacity [0-9]+)" (cdr bounds) t))
                   (insert (format " (opacity %d)" opacity))))
                ((re-search-forward "(line" (cdr bounds) t)
                 (goto-char (1- (cdr bounds)))
                 (insert (format " (lineclr %s)"
                                 (cdr (assoc color djvu-color-alist)))))
                ((re-search-forward "(poly" (cdr bounds) t)
                 (goto-char (1- (cdr bounds)))
                 (insert (format " (border %s) (border_avis)"
                                 (cdr (assoc color djvu-color-alist)))))
                ((re-search-forward "(text" (cdr bounds) t)
                 (goto-char (1- (cdr bounds)))
                 (insert (format " (backclr %s)"
                                 (djvu-color-background color nil opacity))))
                (t (message "Do not know how to update color")))))))

(defun djvu-merge-mapareas (beg end)
  "Merge Djvu mapareas from BEG to END."
  (interactive "r")
  (let (bounds url text rect hilite opacity border)
    (goto-char beg)
    (while (and (< (point) end)
                (setq bounds (djvu-object-bounds)))
      (if (< (car bounds) beg) (setq beg (car bounds)))
      (if (< end (cdr bounds)) (setq end (cdr bounds)))
      (let ((maparea (djvu-object bounds)))
        (unless (eq 'maparea (car maparea))
          (error "Cannot merge `%s'" (car maparea)))
        (push (nth 1 maparea) url)
        (push (nth 2 maparea) text)
        (dolist (elt (nthcdr 3 maparea))
          (cond ((consp (car elt)) ; list of rects
                 (mapc (lambda (r) (push r rect)) elt))
                ((memq (car elt) '(text line))
                 (user-error "Cannot merge text or line mapareas"))
                ((eq (car elt) 'hilite)
                 (push (cadr elt) hilite))
                ((eq (car elt) 'opacity)
                 (push (cadr elt) opacity))
                ((memq (car elt) '(none xor))
                 (push (car elt) border))
                (t
                 (error "Unknown attribute `%s'" elt)))))
      (goto-char (cdr bounds))
      (skip-chars-forward "\s\t\n"))

    ;; Remove duplicate attribute
    (setq url (or (delete-dups (delete "" url)) '("")))
    (if (nth 1 url) (user-error "Cannot merge multiple URLs"))
    (setq text (mapconcat #'identity (nreverse (delete "" text)) "\n"))
    (setq hilite (delete-dups hilite))
    (if (nth 1 hilite) (user-error "Cannot merge multiple hilites"))
    (setq opacity (delete-dups opacity))
    (if (nth 1 opacity) (user-error "Cannot merge multiple opacities"))
    ;; Border `none' is given lower precedence than other borders
    (setq border (or (delete-dups (delq 'none border)) '(none)))
    (if (nth 1 border) (user-error "Cannot merge multiple borders"))

    (goto-char beg)
    (delete-region beg end)
    (insert (format "(maparea %S\n %S\n (" (car url) text)
            (mapconcat #'prin1-to-string (nreverse rect) "\n  ") ")\n"
            (if hilite (format " (hilite %s)" (car hilite)) "")
            (if opacity (format " (opacity %s)" (car opacity)) "")
            (format " (%s)" (car border))
            ")\n")
    (save-restriction
      (narrow-to-region beg (point))
      (djvu-convert-hash t))))

;;; Djvu Bookmarks mode

(defun djvu-bookmarks-page (&optional pnt doc)
  "In Bookmarks buffer return page number at position PNT.
PNT defaults to position of point."
  (djvu-url-page
   (save-excursion
     (if pnt (goto-char pnt))
     (beginning-of-line)
     (while (not (or (bobp)
                     (looking-at "^[\t\s]*(\\(\"\\)")))
       (forward-line -1))
     (when (match-beginning 1)
       (goto-char (match-beginning 1))
       (forward-sexp)
       (read (current-buffer))))
   doc))

(defun djvu-url-page (url &optional doc)
  "For the internal URL return the corresponding page number.
This is the inverse of `djvu-page-url'.
Return nil if URL is not an internal URL."
  ;; If we try to grab URL from a bookmarks or outline buffer, URL may be nil.
  (if url
      ;; Internal URLs start with "#".
      (cond ((string-match "\\`#\\([0-9]+\\)\\'" url)
             (djvu-match-number 1 url))
            ((string-match "\\`#" url)
             (car (rassoc (substring-no-properties url 1)
                          (djvu-ref page-id doc)))))))

(defun djvu-bookmark (text page &optional level)
  "Create bookmark"
  (interactive
   (djvu-with-region region
     (list (djvu-read-string "Bookmark: " region t)
           (djvu-ref page) (djvu-interactive-bookmark-level))))
  ;; Remove newlines from TEXT that are ignored anyway
  (setq text (replace-regexp-in-string "[\n ]+" " " text))
  (let (object)
    (with-current-buffer (djvu-ref bookmarks-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 bookmarks"))))
      (unless (eq 'bookmarks (car object))
        (error "No bookmarks"))
      ;; We keep bookmarks sorted by page number.  So each time we add
      ;; a new bookmark, we rewrite the complete bookmarks buffer.
      ;; This can blow up `buffer-undo-list'.  Can we be smarter?
      (let* ((djvu-bookmark-level -1)
             ;; Catch user errors from splicing before modifying
             ;; the bookmarks buffer.
             (object (djvu-splice-bookmark text page (cdr object) level)))
        (erase-buffer)
        (insert "(bookmarks")
        (djvu-insert-bookmarks object " ")
        (insert ")\n"))
      (goto-char (point-min))
      (undo-boundary))))

(defun djvu-interactive-bookmark-level ()
  "Return bookmark level for interactive commands.
Value is nil if the command is called without prefix arg.
Value is t (one level down) if called with prefix C-u.
Otherwise the raw prefix arg should be a non-negative integer
specifying the absolute level of the bookmark."
  (cond ((consp current-prefix-arg))
        ((integerp current-prefix-arg)
         (abs current-prefix-arg))))

(defun djvu-splice-bookmark (text page object &optional level)
  "Splice bookmark (TEXT PAGE) into tree of bookmarks OBJECT.
If LEVEL is t put bookmark one sublevel below the level
of the preceding bookmark.
If LEVEL is a non-negative integer put bookmark on level LEVEL.
This throws a user error if a bookmark subtree at PAGE extends
beyond PAGE so that putting a new bookmark for PAGE past this subtree
would break the page ordering of the bookmarks.
This code assumes that bookmarks are ordered by page number and that
external URLs appear at the beginning of a subtree of bookmarks."
  (setq djvu-bookmark-level (1+ djvu-bookmark-level))
  (if (or (null object)
          (let ((page-url (djvu-url-page (nth 1 (car object)))))
            (and page-url ; ignore external url
                 (< page page-url))))
      ;; put new bookmark before first bookmark on current level
      (cons (list text (djvu-page-url page)) object)
    (let ((object object))
      (while object
        (if (or (not (djvu-url-page (nth 1 (car object)))) ; ignore external url
                (and (cdr object)
                     (>= page (djvu-url-page (nth 1 (nth 1 object))))))
            (setq object (cdr object)) ; keep searching
          (if (or (and (not level)
                       (nth 2 (car object)))
                  (eq t level)
                  ;; If LEVEL is greater than `djvu-bookmark-level',
                  ;; we add only one level beyond `djvu-bookmark-level',
                  ;; irrespective of the actual value of LEVEL.
                  (and (integerp level)
                       (< djvu-bookmark-level level)))
              ;; go down one level
              (setcar object (cons (nth 0 (car object))
                                   (cons (nth 1 (car object))
                                         (djvu-splice-bookmark
                                          text page (nthcdr 2 (car object))
                                          level))))
            (let (page-max)
              (and (eq level djvu-bookmark-level)
                   (setq page-max (djvu-bookmarks-page-max
                                   (nthcdr 2 (car object))))
                   (< page page-max)
                   (user-error "Bookmark level %d invalid on page %d: preceding subtree extends to page %d"
                               level page page-max)))
            ;; put new bookmark after current bookmark on current level
            (setcdr object (cons (list text (djvu-page-url page))
                                 (cdr object))))
          (setq object nil))))
    object))

(defun djvu-bookmarks-page-max (object)
  "Return maximum page number of a bookmark tree OBJECT.
Return nil if OBJECT does not have internal URLs."
  (let (page page-max)
    (dolist (elt object)
      (and (setq page (djvu-url-page (nth 1 elt)))
           (setq page-max (if page-max
                              (max page-max page)
                            page)))
      (and (nth 2 elt)
           (setq page (djvu-bookmarks-page-max (nthcdr 2 elt)))
           (setq page-max (if page-max
                              (max page-max page)
                            page))))
    page-max))

(defun djvu-insert-bookmarks (object indent)
  "Insert Bookmarks OBJECT recursively."
  (let ((indent1 (concat indent " ")))
    (dolist (elt object)
      (insert (format "\n%s(%S\n%s %S" indent (car elt) indent
                      (djvu-resolve-url (nth 1 elt))))
      (djvu-insert-bookmarks (nthcdr 2 elt) indent1)
      (insert ")"))))

(defun djvu-read-bookmarks (&optional doc)
  "Read bookmarks of a Djvu document from bookmarks buffer."
  (let (object)
    (with-current-buffer (djvu-ref bookmarks-buf doc)
      (save-excursion
        (save-restriction
          (widen)
          (goto-char (point-min))
          (unless (eobp)
            (condition-case nil
                (setq object (read (current-buffer)))
              (error (error "Syntax error in bookmarks"))))
          (skip-chars-forward " \t\n")
          ;; We should have swallowed all bookmarks.
          (unless (eobp)
            (error "Syntax error in bookmarks (position %s)" (point))))))
    (if (and object (not (eq 'bookmarks (car object))))
        (error "Malformed bookmarks"))
    object))

(defun djvu-reformat-bookmarks (&optional doc)
  "Reformat Bookmarks buffer for Djvu document DOC."
  (interactive)
  (with-current-buffer (djvu-ref bookmarks-buf doc)
    (let ((pnt (point))
          (object (djvu-read-bookmarks doc)))
      (erase-buffer)
      (insert "(bookmarks")
      (djvu-insert-bookmarks (cdr object) " ")
      (insert ")\n")
      (goto-char pnt))))

(defun djvu-save-bookmarks (script &optional doc)
  "Save bookmarks of a Djvu document.
This dumps the content of DOC's bookmarks buffer into the djvused script
file SCRIPT. DOC defaults to the current Djvu document."
  (unless doc (setq doc djvu-doc))
  (let ((object (djvu-read-bookmarks doc)))
    (with-temp-buffer
      (setq buffer-file-coding-system 'utf-8)
      (insert "set-outline\n")
      (when object
        (insert "(bookmarks")
        (let ((djvu-doc doc)) ; DOC should definitely be initialized above
          (djvu-insert-bookmarks (cdr object) " "))
        (insert ")\n"))
      (insert ".\n")
      (write-region nil nil script t 0)) ; append to SCRIPT
    (djvu-init-outline (cdr object) doc)))

;;; Djvu Outline mode

(defun djvu-init-outline (object &optional doc)
  (with-current-buffer (djvu-ref outline-buf doc)
    (let (buffer-read-only)
      (erase-buffer)
      (djvu-insert-outline object ""))
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)
    (djvu-goto-outline (or (djvu-ref page doc) 1))))

(defun djvu-insert-outline (object indent)
  "Insert Outline OBJECT recursively."
  (let ((indent1 (concat indent "  "))
        (djvu-resolve-url 'short))
    (dolist (elt object)
      (let ((beg (point)))
        (insert indent (car elt))
        (make-text-button beg (point) 'type 'djvu-url
                          ;; Inspired by function `outline-font-lock-face'
                          'face (aref djvu-outline-faces
                                      (% (/ (length indent) 2)
                                         (length djvu-outline-faces)))
                          'help-echo (format "mouse-2, RET: url `%s'"
                                             (nth 1 elt))
                          'djvu-args (list (nth 1 elt))))
      (insert "\s" (substring (djvu-resolve-url (nth 1 elt)) 1) "\n")
      (djvu-insert-outline (nthcdr 2 elt) indent1))))

(defun djvu-outline-page (&optional pnt doc)
  "In Outline buffer return page number at position PNT.
PNT defaults to position of point."
  (djvu-url-page
   (car (get-text-property
         (save-excursion
           (if pnt (goto-char pnt))
           (beginning-of-line)
           (skip-chars-forward "\s\t")
           (point))
         'djvu-args))
   doc))

(defun djvu-goto-outline (&optional page doc)
  "In Outline buffer go to first bookmark matching PAGE."
  (unless page (setq page (djvu-ref page doc)))
  (goto-char (point-min))
  (let ((pnt (point)) p done)
    (while (not (or done (eobp)))
      (when (setq p (djvu-outline-page (point) doc))
        (if (<= p page)
            (setq pnt (point)))
        (setq done (= p page)))
      (forward-line))
    (goto-char pnt)))

;;; Image minor mode

(defmacro djvu-with-event-buffer (event &rest body)
  "With buffer of EVENT current, evaluate BODY."
  (declare (indent 1))
  ;; Fixme: abort if `minibufferp' returns non-nil?
  `(with-current-buffer
       (window-buffer (let ((win (posn-window (event-start ,event))))
                        (if (windowp win) win
                          (user-error "Event not over window"))))
     ,@body))

(defun djvu-image-toggle ()
  "Toggle image display of current page."
  (interactive)
  (if (display-images-p)
      ;; arg as in interactive definition of
      ;; `define-derived-mode'
      (djvu-image-mode (or current-prefix-arg 'toggle))
    (message "Cannot display images")))

(define-minor-mode djvu-image-mode
  "Image display of current page."
  :lighter "Image"

  ;; Keybindings for motion commands adopted from `image-mode-map'
  :keymap '((" "              . djvu-image-scroll-up)
            ([?\S-\ ]         . djvu-image-scroll-down)
            ("\C-?"           . djvu-image-scroll-down)
            ([remap scroll-up-command]      . djvu-image-scroll-up)
            ([remap scroll-down-command]    . djvu-image-scroll-down)
            ([remap next-line]              . djvu-image-next-line)
            ([remap previous-line]          . djvu-image-previous-line)
            ([remap forward-char]           . image-forward-hscroll)
            ([remap backward-char]          . image-backward-hscroll)
            ([remap right-char]             . image-forward-hscroll)
            ([remap left-char]              . image-backward-hscroll)
            ([remap move-beginning-of-line] . image-bol)
            ([remap move-end-of-line]       . image-eol)
            ([remap beginning-of-buffer]    . image-bob)
            ([remap end-of-buffer]          . image-eob)
            ;;
            ("+" . djvu-image-zoom-in)
            ("-" . djvu-image-zoom-out)

            ([drag-mouse-1]   . djvu-mouse-rect-area)
            ([S-drag-mouse-1] . djvu-mouse-text-area)
            ([C-drag-mouse-1] . djvu-mouse-text-area-pushpin)
            ([drag-mouse-2]   . djvu-mouse-line-area)
            ([S-drag-mouse-2] . djvu-mouse-line-area-horiz)
            ([C-drag-mouse-2] . djvu-mouse-line-area-vert)
            ;;
            ([down-mouse-1]   . djvu-mouse-drag-track-area)
            ([S-down-mouse-1] . djvu-mouse-drag-track-area)
            ([C-down-mouse-1] . djvu-mouse-drag-track-area)
            ([down-mouse-2]   . (lambda (event) (interactive "e")
                                  (djvu-mouse-drag-track-area event t)))
            ([S-down-mouse-2] . (lambda (event) (interactive "e")
                                  (djvu-mouse-drag-track-area event 'horiz)))
            ([C-down-mouse-2] . (lambda (event) (interactive "e")
                                  (djvu-mouse-drag-track-area event 'vert)))
            ;; FIXME: The following binding has no effect.  Why??
            ([M-drag-mouse-1] . djvu-mouse-word-area)
            ([M-down-mouse-1] . djvu-mouse-drag-track-area)
            ([drag-mouse-3]   . djvu-mouse-word-area) ; substitute
            ([down-mouse-3]   . djvu-mouse-drag-track-area)) ; substitute

  (image-mode-setup-winprops)

  (let* ((display (get-text-property (point-min) 'display))
         (enable (and djvu-image-mode (not display)))
         (disable (and (not djvu-image-mode) display)))
    (cond (enable
           ;; Remember DPOS if we enable `djvu-image-mode'.
           (djvu-set read-pos (let (djvu-image-mode)
                                (djvu-read-dpos)))
           ;; Don't scroll unless the user specifically asked for it.
           (setq-local auto-hscroll-mode nil))
          (disable
           ;; Remember scrolling when we leave image mode
           (djvu-set image-vscroll (djvu-image-vscroll))
           (djvu-set image-hscroll (window-hscroll))
           (set-window-hscroll (selected-window) 0)))

    (if (or enable disable) (djvu-image))

    (cond (enable
           ;; Code adopted from `image-bol'.
           (let* ((image-size (image-display-size
                               (image-get-display-property)))
                  (img-width  (ceiling (car image-size)))
                  (img-height (ceiling (cdr image-size)))
                  (edges (window-inside-edges))
                  (win-width  (- (nth 2 edges) (nth 0 edges)))
                  (win-height (- (nth 3 edges) (nth 1 edges))))
             (image-set-window-vscroll (min (djvu-ref image-vscroll)
                                            (max 0 (- img-height win-height))))
             (image-set-window-hscroll (min (djvu-ref image-hscroll)
                                            (max 0 (- img-width win-width))))))
          (disable
           ;; Go to DPOS if we disable `djvu-image-mode'.
           (djvu-goto-read (djvu-ref read-pos))))))

(defun djvu-image (&optional isize)
  "If `djvu-image-mode' is enabled, display image of current Djvu page.
Otherwise remove the image."
  ;; Strange!  `djvu-image' modifies the buffer (its text properties).
  ;; Nonetheless, we end up with an unmodified buffer.  This holds,
  ;; in particular, for the "bare" calls of `djvu-image' by
  ;; `djvu-image-zoom-in' and `djvu-image-zoom-out'.
  (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-ref page) (car (djvu-ref image))))
            (and isize
                 (not (eq isize (nth 1 (djvu-ref image))))))
        (let ((isize (or isize
                         (nth 1 (djvu-ref image))
                         djvu-image-size))
              (doc djvu-doc)
              (inhibit-quit t))
          (with-temp-buffer
            (set-buffer-multibyte nil)
            (let* ((coding-system-for-read 'raw-text)
                   ;; For a rectangular image, ISIZE does not give us
                   ;; the actual size of the image, but (max width height)
                   ;; will be equal to ISIZE.
                   (status (call-process "ddjvu" nil t nil
                                         (format "-size=%dx%d" isize isize)
                                         "-format=ppm"
                                         (format "-page=%d" (djvu-ref page doc))
                                         (djvu-ref file doc))))
              (unless (zerop status)
                (error "Ddjvu error %s" status))
              (djvu-set image
               (append (list (djvu-ref page doc) isize)
                       ;; Images are lists
                       (create-image (buffer-substring-no-properties
                                      (point-min) (point-max))
                                     'pbm t))
               doc)))))
    ;; Display image.
    (let (buffer-read-only)
      (if (= (point-min) (point-max)) (insert " "))
      (put-text-property (point-min) (point-max)
                         'display (nthcdr 2 (djvu-ref image))))))

;; The following scrolling commands are adapted from `image-mode'
;; and `doc-view-mode'.

(defun djvu-image-vscroll ()
  "Return the amount by which a page image is scrolled vertically."
  ;; Up to Emacs 26, the functions `image-scroll-down', `image-scroll-up',
  ;; `image-next-line', and `image-previous-line' return multiples of the
  ;; character height.  Starting with Emacs 27, these functions return
  ;; pixel values.  To be compatible, we must call `window-vscroll'
  ;; without or with arg PIXELS-P non-nil.
  (window-vscroll nil (<= 27 (string-to-number emacs-version))))

(defun djvu-image-scroll-up (&optional n)
  "Scroll image of current page upward by N lines.
At the bottom of the image, when `djvu-continuous' is non-nil
go to the image of the next page.
Prefix N may take the same values as arg N of `image-scroll-up'."
  (interactive "P") ; same as `image-scroll-up'
  (if (and (= (djvu-image-vscroll) (image-scroll-up n))
           djvu-continuous
           (< (djvu-ref page) (djvu-ref pagemax)))
      (let ((hscroll (window-hscroll)))
        (djvu-next-page 1)
        (image-bob)
        (image-bol 1)
        (image-set-window-hscroll hscroll))))

(defun djvu-image-scroll-down (&optional n)
  "Scroll image of current page downward N lines.
At the top of the image, when `djvu-continuous' is non-nil
go to the image of the previous page.
Prefix N may take the same values as arg N of `image-scroll-down'."
  (interactive "P") ; same as `image-scroll-down'
  (if (and (= (djvu-image-vscroll) (image-scroll-down n))
           djvu-continuous
           (< 1 (djvu-ref page)))
      (let ((hscroll (window-hscroll)))
        (djvu-prev-page 1)
        (image-eob)
        (image-bol 1)
        (image-set-window-hscroll hscroll))))

(defun djvu-image-next-line (&optional n)
  "Scroll image of current page upward by N lines.
At the bottom of the image, when `djvu-continuous' is non-nil,
go to the image of the next page."
  (interactive "p")
  (if (and (= (djvu-image-vscroll) (image-next-line n))
           djvu-continuous
           (< (djvu-ref page) (djvu-ref pagemax)))
      (let ((hscroll (window-hscroll)))
        (djvu-next-page 1)
        (image-bob)
        (image-bol 1)
        (image-set-window-hscroll hscroll))))

(defun djvu-image-previous-line (&optional n)
  "Scroll image of current page downward N lines.
At the top of the image, when `djvu-continuous' is non-nil,
go to the image of the previous page."
  (interactive "p")
  (if (and (= (djvu-image-vscroll) (image-previous-line n))
           djvu-continuous
           (< 1 (djvu-ref page)))
      (let ((hscroll (window-hscroll)))
        (djvu-prev-page 1)
        (image-eob)
        (image-bol 1)
        (image-set-window-hscroll hscroll))))

(defun djvu-image-zoom-in (&optional zoom)
  (interactive)
  ;; FIXME: this preserves the upper left corner of the image.
  ;; If possible, we should preserve the center of the image.
  (let ((hscroll (window-hscroll))
        (vscroll (djvu-image-vscroll))
        (zoom (or zoom djvu-image-zoom)))
    (djvu-image (round (* (nth 1 (djvu-ref image)) zoom)))
    (image-set-window-hscroll (round (* hscroll zoom)))
    (image-set-window-vscroll (round (* vscroll zoom)))))

(defun djvu-image-zoom-out (&optional zoom)
  (interactive)
  (let ((hscroll (window-hscroll))
        (vscroll (djvu-image-vscroll))
        (zoom (or zoom djvu-image-zoom)))
    (djvu-image (round (/ (nth 1 (djvu-ref image)) zoom)))
    (image-set-window-hscroll (round (/ hscroll zoom)))
    (image-set-window-vscroll (round (/ vscroll zoom)))))

;; Image-based editing commands

(defun djvu-mouse-drag-track-area (start-event &optional line)
  "Track drag over image."
  (interactive "e")
  ;; Inspired by `mouse-drag-track'.
  (let ((old-track-mouse track-mouse))
    ;; Disable `djvu-modified' during tracking,
    ;; but we just remember the current modified flag.
    ;; This makes the code much faster!
    (remove-hook 'post-command-hook #'djvu-modified t)
    (setq djvu-modified (buffer-modified-p))
    (setq track-mouse 'drag-tracking)
    (set-transient-map
     (let ((map (make-sparse-keymap)))
       (define-key map [mouse-movement]
         (lambda (event) (interactive "e")
           (djvu-with-event-buffer event
             (djvu-image-rect (list 'down-mouse-1
                                    (event-start start-event)
                                    (event-end event))
                              line))))
       map)
     t (lambda ()
         (add-hook 'post-command-hook #'djvu-modified nil t)
         (setq djvu-modified nil)
         (setq track-mouse old-track-mouse)))))

(defun djvu-image-rect (&optional event line)
  "For PPM image specified via EVENT mark rectangle by inverting bits."
  ;; FIXME: Can the following be implemented more efficiently in the
  ;; image display code?  Could this be useful for other packages, too?
  (if event
      (let* ((e-start (event-start event))
             (e-end   (event-end   event))
             (_ (unless (and (posn-image e-start) (posn-image e-end))
                  (user-error "Area not over image")))
             (start (posn-object-x-y e-start))
             (end   (posn-object-x-y e-end))
             (x1 (if line (car start)
                   (min (car start) (car end))))
             (y1 (if line (cdr start)
                   (min (cdr start) (cdr end))))
             (x2 (if line (car end)
                   (max (car start) (car end))))
             (y2 (if line (cdr end)
                   (max (cdr start) (cdr end))))
             (image (copy-sequence (nth 6 (djvu-ref image))))
             (_ (unless (string-match "\\`P6\n\\([0-9]+\\) +\\([0-9]+\\)\n\\([0-9]+\\)\n" image)
                  (error "Not a PPM image")))
             (width (djvu-match-number 1 image))
             ; (height (djvu-match-number 2 image))
             (depth (djvu-match-number 3 image))
             (i0 (match-end 0))
             (old-image (get-text-property (point-min) 'display)))
        (unless (= depth 255)
          (error "Cannot handle depth %d" depth))
        (cl-flet ((invert (i imax)
                          (while (< i imax)
                            ;; Invert bits
                            (aset image i (- 255 (aref image i)))
                            (setq i (1+ i)))))
          (if (not line)
              (while (< y1 y2)
                ;; i = i0 + 3 * (y * width + x)
                (let ((i (+ i0 (* 3 (+ x1 (* width y1))))))
                  (invert i (+ i (* 3 (- x2 x1)))))
                (setq y1 (1+ y1)))
            (cond ((eq line 'horiz) (setq y2 y1))
                  ((eq line 'vert)  (setq x2 x1)))
            (if (< (abs (- x2 x1)) (abs (- y2 y1)))
                (let ((dx (/ (- x2 x1) (float (- y2 y1))))
                      (y y1) (step (cl-signum (- y2 y1))))
                  (while (/= y y2)
                    ;; x = (y - y1) * dx + x1
                    (let ((i (+ i0 (* 3 (+ (* y width) x1
                                           (round (* (- y y1) dx)))))))
                      (invert i (+ i 3)))
                    (setq y (+ y step))))
              (let ((dy (/ (- y2 y1) (float (- x2 x1))))
                    (x x1) (step (cl-signum (- x2 x1))))
                (while (/= x x2)
                  ;; y = (x - x1) * dy + y1
                  (let ((i (+ i0 (* 3 (+ x (* (+ y1 (round (* (- x x1) dy)))
                                              width))))))
                    (invert i (+ i 3)))
                  (setq x (+ x step)))))))
        (let (buffer-read-only)
          (put-text-property
           (point-min) (point-max) 'display
           (create-image image 'pbm t)))
        (restore-buffer-modified-p djvu-modified)
        (image-flush old-image))
    ;; Restore unmodified image
    (let ((old-image (get-text-property (point-min) 'display))
          buffer-read-only)
      ;; The modified flag is set by `djvu-modified' in `post-command-hook'.
      (put-text-property (point-min) (point-max)
                         'display (nthcdr 2 (djvu-ref image)))
      (image-flush old-image))))

(defun djvu-event-to-area (event &optional dir)
  "Convert mouse EVENT to Djvu area coordinates."
  (let* ((e-start (event-start event))
         (e-end   (event-end   event))
         (_ (unless (and (posn-image e-start) (posn-image e-end))
              (user-error "Area not over image")))
         (start (posn-object-x-y e-start))
         (end   (posn-object-x-y e-end))
         (x1 (car start)) (y1 (cdr start)) (x2 (car end)) (y2 (cdr end))
         (size (posn-object-width-height e-start))
         (_ (if (equal size '(0 . 0))
                (error "See Emacs bug#18839 (GNU Emacs 24.4)")))
         (width  (/ (float (car (djvu-ref pagesize))) (car size)))
         (height (/ (float (cdr (djvu-ref pagesize))) (cdr size)))
         (area
          (list (round (* (if (memq dir '(vert free))
                              x1 (min x1 x2))
                          width))
                (round (* (- (cdr size) (if (memq dir '(horiz free))
                                            y1 (max y1 y2)))
                          height))
                (round (* (if (memq dir '(vert free))
                              x2 (max x1 x2))
                          width))
                (round (* (- (cdr size) (if  (memq dir '(horiz free))
                                            y2 (min y1 y2)))
                          height)))))
    (djvu-set read-pos (djvu-mean-dpos area))
    area))

(defun djvu-mouse-rect-area (event)
  (interactive "e")
  ;; Mouse events ignore prefix args?
  (djvu-with-event-buffer event
    (unwind-protect
        (let ((color (djvu-interactive-color djvu-color-highlight))
              ;; Do RECTS first as this may throw a user error.
              (rects (list (djvu-event-to-area event))))
          (djvu-rect-area nil (read-string (format "(%s) Highlight: "
                                                   (or color "no color"))
                                           nil nil nil djvu-inherit-input-method)
                          rects color djvu-opacity 'none))
      (djvu-image-rect))))

(defun djvu-mouse-text-area (event)
  (interactive "e")
  (djvu-mouse-text-area-internal event "Text"))

(defun djvu-mouse-text-area-pushpin (event)
  (interactive "e")
  (djvu-mouse-text-area-internal event "Text w/Pushpin" t))

(defun djvu-mouse-text-area-internal (event prompt &optional pushpin)
  ;; Mouse events ignore prefix args?
  (djvu-with-event-buffer event
    (unwind-protect
        (let ((color (djvu-interactive-color djvu-color-highlight))
              ;; Do AREA first as this may throw a user error.
              (area (djvu-event-to-area event)))
          (djvu-text-area nil (read-string (format "(%s) %s: "
                                                   (or color "no color") prompt)
                                           nil nil nil djvu-inherit-input-method)
                          area nil (djvu-color-background color) nil pushpin))
      (djvu-image-rect))))

(defun djvu-mouse-line-area (event)
  (interactive "e")
  (djvu-mouse-line-area-internal event 'free))

(defun djvu-mouse-line-area-horiz (event)
  (interactive "e")
  (djvu-mouse-line-area-internal event 'horiz))

(defun djvu-mouse-line-area-vert (event)
  (interactive "e")
  (djvu-mouse-line-area-internal event 'vert))

(defun djvu-mouse-line-area-internal (event &optional dir)
  (djvu-with-event-buffer event
    (unwind-protect
        ;; Do LINE first as this may throw a user error.
        (let* ((line (djvu-event-to-area event dir))
               (color (djvu-interactive-color djvu-color-line))
               (text (read-string (format "(%s) Line: " (or color "no color"))
                                  nil nil nil djvu-inherit-input-method)))
          (cond ((eq dir 'horiz)
                 (setq line (list (nth 0 line) (nth 1 line)
                                  (nth 2 line) (nth 1 line))))
                ((eq dir 'vert)
                 (setq line (list (nth 0 line) (nth 1 line)
                                  (nth 0 line) (nth 3 line)))))
          (djvu-line-area nil text line nil nil
                          djvu-line-width djvu-color-line))
      (djvu-image-rect))))

(defun djvu-line-area (url text line &optional border arrow width lineclr)
  ;; Record position where annotation was made.
  (with-current-buffer (djvu-ref annot-buf)
    (goto-char (point-max))
    ;; It seems that TEXT is ignored by djview.
    (insert (format "(maparea %S\n %S\n "
                    (or url "") (if text (djvu-fill text) ""))
            (apply 'format "(line %d %d %d %d)" (djvu-bound-area line))
            ;; According to Sec. 8.3.4.2.3.1 of djvu3spec.djvu
            ;; lines may have border options.
            ;; Man djvused: Border options do not apply to line areas.
            (format " (%s)" (or border 'none))
            (if arrow " (arrow)" "")
            (if width (format " (width %d)" width) "")
            (djvu-insert-color "lineclr" lineclr)
            ")\n\n")
    (undo-boundary)))

(defun djvu-text-line-area (string area &optional doc)
  (with-current-buffer (djvu-ref text-buf doc)
    (goto-char (point-max))
    (skip-chars-backward " \t\n")
    (backward-char) ; ")"
    (insert (apply 'format "\n (line %d %d %d %d" area))
    (let* ((word-list (split-string string))
           (n (+ (length (apply 'concat word-list)) ; # word characters
                 -1 (length word-list)))            ; # spaces
           (m1 0) (m2 (1+ n))
           (x1 (nth 0 area)) (x2 (nth 2 area))
           (width (/ (- x2 x1) (float n)))          ; pixels per character
           word)
      (dotimes (i (length word-list))
        (setq word (nth i word-list))
        (setq m2 (- m2 1 (length word)))
        (insert (format "\n  (word %d %d %d %d %S)"
                        (+ x1 (round (* m1 width)))
                        (nth 1 area)
                        (- x2 (round (* m2 width)))
                        (nth 3 area)
                        word))
        (setq m1 (+ m1 1 (length word)))))
    (insert ")")))

(defun djvu-mouse-word-area (event)
  "Insert word."
  (interactive "e")
  (djvu-with-event-buffer event
    (unwind-protect
        ;; Do AREA first as this may throw a user error.
        (let ((area (djvu-event-to-area event)))
          (with-current-buffer (djvu-ref text-buf)
            (djvu-text-line-area (read-string "Text: " nil nil nil
                                              djvu-inherit-input-method)
                                 area)))
      (djvu-image-rect))))

;;; Miscellaneous commands

(defun djvu-interactive-pages (&optional doc)
  "Specify page range to operate on in interactive calls.
Without a prefix, return nil meaning \"all pages\".
Otherwise return a cons pair (PAGE1 . PAGE2).
With prefix C-u, this becomes the current page.
With prefix C-u C-u, read page range from minibuffer."
  (let ((pages (cond ((equal '(16) current-prefix-arg)
                      (cons (read-number "First page: " 1)
                            (read-number "Last page: "
                                         (djvu-ref pagemax doc))))
                     (current-prefix-arg
                      (cons (djvu-ref page doc) (djvu-ref page doc))))))
    ;; Return cons (STRING . PAGES).
    (cons (if pages
              (if (eq (car pages) (cdr pages))
                  (if (eq (car pages) (djvu-ref page doc)) "current page"
                    (format "page %d" (car pages)))
                (format "pages %d-%d" (car pages) (cdr pages)))
            "all pages")
          pages)))

(defun djvu-pages-action (pages action doc)
  "Apply ACTION to PAGES of Djvu document DOC.
If PAGES is nil, operate on all pages.
Otherwise PAGES is a cons pair (PAGE1 . PAGE2)."
  (unless doc (setq doc djvu-doc))
  (djvu-save doc t)
  (if pages
      (djvu-djvused doc nil "-e"
                    (mapconcat
                     (lambda (page)
                       (format "select %s; %s" page action))
                     (number-sequence
                      (max 1 (car pages))
                      (min (djvu-ref pagemax doc) (cdr pages)))
                     "; ")
                    "-s")
    (djvu-djvused doc nil "-e"
                  (format "select; %s" action)
                  "-s")))

(defun djvu-dpi (dpi &optional pages doc)
  "Set DPI resolution of djvu document DOC.
If optional arg PAGES is nil, operate on all pages.
Otherwise PAGES is a cons pair (PAGE1 . PAGE2).
With prefix C-u, PAGES becomes the current page.
With prefix C-u C-u, read range PAGES from minibuffer."
  ;; PAGES could also be a proper list.  Useful??
  (interactive
   (let ((pages (djvu-interactive-pages)))
     (list (read-number (format "(%s) Dpi: " (car pages)))
           (cdr pages))))
  (djvu-pages-action pages (format "set-dpi %d" dpi) doc))

(defun djvu-dpi-unify (width dpi &optional doc)
  "Unify the ratio WIDTH / DPI of all pages of a Djvu document.
If the width of a page exceeds WIDTH, increase the page resolution DPI
accordingly."
  (interactive "nWidth: \nnWidth: %s, dpi: ")
  (unless doc (setq doc djvu-doc))
  (let (job)
    (with-temp-buffer
      (djvu-djvused doc t "-e" "size")
      (goto-char (point-min))
      (let ((page 0))
        (while (looking-at "width=\\([[:digit:]]+\\)")
          (setq page (1+ page))
          (let ((d (/ (* (djvu-match-number 1) dpi) width)))
            (if (< dpi d)
                (push (cons page d) job)))
          (forward-line))))
    (if (not job)
        (message "Nothing to unify")
      (djvu-djvused doc nil "-e"
                    (mapconcat (lambda (elt)
                                 (format "select %s; set-dpi %d"
                                         (car elt) (cdr elt)))
                               job "; ")
                    "-s")
      (message "%s pages updated: %s" (length job)
               (mapconcat (lambda (elt) (format "%d" (car elt)))
                          (nreverse job) ", ")))))

(defun djvu-rotate (&optional rot pages doc)
  "Set rotation of Djvu document DOC.
The rotation angle ROT is in multiples of 90 degrees counterclockwise.
If string ROT has prefix [+-] apply relative rotation.
If optional arg PAGES is nil, operate on all pages.
Otherwise PAGES is a cons pair (PAGE1 . PAGE2).
With prefix C-u, PAGES becomes the current page.
With prefix C-u C-u, read range PAGES from minibuffer."
  (interactive
   (let ((pages (djvu-interactive-pages)))
     (list (read-string
            (format "(%s) Rotate ([+-]0...3, default +1): " (car pages))
            nil nil "+1")
           (cdr pages))))
  (cond ((or (not rot) (equal rot ""))
         (setq rot "+1"))
        ((not (string-match "\\`[-+]?[0123]\\'" rot))
         (user-error "Djvu rotation `%s' invalid" rot)))
  (djvu-pages-action pages (format "set-rotation %s" rot) doc))

(defun djvu-page-title (title &optional pages doc)
  "Set page TITLE of Djvu document DOC.
If TITLE is empty string or nil remove page title.
If optional arg PAGES is nil, operate on all pages.
Otherwise PAGES is a cons pair (PAGE1 . PAGE2).
With prefix C-u, PAGES becomes the current page.
With prefix C-u C-u, read range PAGES from minibuffer."
  ;; Fixme: we could also generate some generic distinct title
  ;; for each page.  Is this useful?
  (interactive
   (let ((pages (djvu-interactive-pages)))
     (list (read-string (format "(%s) Page title: " (car pages)))
           (cdr pages))))
  (unless doc (setq doc djvu-doc))
  (if (and (stringp title)
           (not (equal "" title)))
      ;; set-page-title only operates on individual pages,
      ;; though page titles need not be distinct.
      (djvu-pages-action (or pages (cons 1 (djvu-ref pagemax doc)))
                         (format "set-page-title %s" title) doc)
    ;; Remove page titles:
    ;; djvused does not have a command remove-page-title.
    ;; Instead for each page we must set the page title to the page-id.
    (djvu-save doc t)
    (djvu-djvused doc nil "-e"
                  (mapconcat (lambda (page)
                               (format "select %d; set-page-title %s" page
                                       (cdr (assq page (djvu-ref page-id doc)))))
                             (number-sequence (or (car pages) 1)
                                              (or (cdr pages) (djvu-ref pagemax doc)))
                             "; ")
                  "-s")))

(defun djvu-ls (&optional doc)
  "List component files in the Djvu document.
This uses the command \"djvused doc.djvu -e ls\"."
  (interactive)
  (let ((buffer (get-buffer-create "*djvu-ls*"))
        (doc (or doc djvu-doc)))
    (with-current-buffer buffer
      (let ((buffer-undo-list t)
            buffer-read-only)
        (erase-buffer)
        (djvu-djvused doc t "-e" "ls"))
      (set-buffer-modified-p nil)
      (setq buffer-read-only t)
      (goto-char (point-min)))
    (pop-to-buffer buffer)))

;;;###autoload
(defun djvu-inspect-file (file &optional page)
  "Inspect Djvu FILE on PAGE.
Call djvused with the same sequence of arguments that is used
by `djvu-init-page'.  Display the output in `djvu-script-buffer'.
This may come handy if `djvu-find-file' chokes on a Djvu file."
  (interactive (djvu-read-file-name))
  (with-current-buffer (get-buffer-create djvu-script-buffer)
    (erase-buffer)
    (let* ((coding-system-for-read 'utf-8)
           (fmt (concat "create-shared-ant; print-ant; n; ls; print-outline; "
                        "select %d; size; print-txt; print-ant;"))
           (status (apply 'call-process "djvused" nil t nil
                          (list "-u" file "-e" (format fmt (or page 1))))))
      (unless (zerop status)
        (error "Djvused error %s" status)))
    (set-buffer-modified-p nil)
    (goto-char (point-min)))
  (pop-to-buffer djvu-script-buffer))

;;; Destructive commands: use with care!

(defun djvu-delete-page (&optional doc)
  "Delete current page from the Djvu document.  Use with care!"
  (interactive)
  (unless doc (setq doc djvu-doc))
  (djvu-save doc t)
  (when (and (< 1 (djvu-ref pagemax doc))
             (yes-or-no-p "Delete current page "))
    ;; We resolve all internal URLs to `long'.
    ;; So those URLs pointing to pages that are not deleted remain valid.
    ;; Internal URLs pointing to the deleted page become meaningless.
    ;; We do not worry about this here and now as it is harmless.
    ;; Yet `djvu-unresolve-url' will issue a warning message next time
    ;; such a meaningless internal URL is read or stored again.
    (djvu-resolve-all-urls 'long doc)
    (djvu-backup doc)
    (let* ((inhibit-quit t)
           (page (djvu-ref page doc))
           (status (call-process "djvm" nil nil nil "-d"
                                 (djvu-ref file doc) (number-to-string page))))
      (unless (zerop status) (error "Djvm error %s" status))
      (djvu-all-buffers doc
        (set-visited-file-modtime))
      ;; Update internal variables
      (djvu-set image nil doc)
      (let ((page-id (delq (assq page (djvu-ref page-id doc))
                           (djvu-ref page-id doc)))
            (p (1+ page))
            p-i)
        (while (<= p (djvu-ref pagemax doc))
          (setq p-i (assq p page-id)
                page-id (cons (cons (1- p) (cdr p-i))
                              (delq p-i page-id))
                p (1+ p)))
        (djvu-set page-id page-id doc))
      (djvu-set pagemax (1- (djvu-ref pagemax doc)) doc)
      ;; Redisplay
      (djvu-init-page (min page (djvu-ref pagemax doc)) doc))))

(defun djvu-remove-annot (&optional doc outline)
  "Remove Annotations.  Use with care!
With prefix OUTLINE non-nil remove Outline, too."
  (interactive (list nil current-prefix-arg))
  (unless doc (setq doc djvu-doc))
  (djvu-save doc t)
  (when (yes-or-no-p (format "Remove Annotations%s: "
                             (if outline " and Outline" "")))
    (djvu-djvused doc nil "-e"
                  (format "select; remove-ant;%s"
                          (if outline " set-outline;\n." ""))
                  "-s")
    (djvu-init-page nil doc)))

;;;; Emacs bookmark integration (inspired by doc-view.el)

(declare-function bookmark-make-record-default "bookmark"
                  (&optional no-file no-context posn))
(declare-function bookmark-prop-get "bookmark" (bookmark prop))
(declare-function bookmark-get-filename "bookmark" (bookmark))
(declare-function bookmark-get-front-context-string "bookmark" (bookmark))
(declare-function bookmark-get-rear-context-string "bookmark" (bookmark))
(declare-function bookmark-get-position "bookmark" (bookmark))

(defun djvu-bookmark-make-record ()
  (nconc (bookmark-make-record-default)
         `((page . ,(djvu-ref page))
           (d-buffer . ,djvu-buffer)
           (handler . djvu-bookmark-handler))))

;; Adapted from `bookmark-default-handler'.
;;;###autoload
(defun djvu-bookmark-handler (bmk)
  "Handler to jump to a particular bookmark location in a djvu document.
BMK is a bookmark record, not a bookmark name (i.e., not a string).
Changes current buffer and point and returns nil, or signals a `file-error'."
  (let ((file          (bookmark-get-filename bmk))
	(buf           (bookmark-prop-get bmk 'buffer))
        (d-buffer      (bookmark-prop-get bmk 'd-buffer))
        (page          (bookmark-prop-get bmk 'page))
        (forward-str   (bookmark-get-front-context-string bmk))
        (behind-str    (bookmark-get-rear-context-string bmk))
        (pos           (bookmark-get-position bmk)))
    (set-buffer
     (cond
      ((and file (file-readable-p file) (not (buffer-live-p buf)))
       (find-file-noselect file))
      ;; No file found.  See if buffer BUF has been created.
      ((and buf (get-buffer buf)))
      (t ;; If not, raise error.
       (signal 'bookmark-error-no-filename (list 'stringp file)))))
    (if page (djvu-goto-page page))
    (if d-buffer
        (set-buffer
         (pcase d-buffer
           (`read (djvu-ref read-buf))
           (`text (djvu-ref text-buf))
           (`annot (djvu-ref annot-buf))
           (`shared (djvu-ref shared-buf))
           (`bookmarks (djvu-ref bookmarks-buf))
           (`outline (djvu-ref outline-buf)))))
    (if pos (goto-char pos))
    ;; Go searching forward first.  Then, if forward-str exists and
    ;; was found in the file, we can search backward for behind-str.
    ;; Rationale is that if text was inserted between the two in the
    ;; file, it's better to be put before it so you can read it,
    ;; rather than after and remain perhaps unaware of the changes.
    (when (and forward-str (search-forward forward-str (point-max) t))
      (goto-char (match-beginning 0)))
    (when (and behind-str (search-backward behind-str (point-min) t))
      (goto-char (match-end 0)))
    nil))


(provide 'djvu)
;;; djvu.el ends here
