unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Jan Nieuwenhuizen <janneke@gnu.org>
Cc: karl@freefriends.org
Subject: [PATCH]: images for info
Date: Mon, 21 Apr 2003 18:59:54 +0200	[thread overview]
Message-ID: <87fzobkcqd.fsf@peder.flower> (raw)


This weekend, Karl has installed my patch to texinfo to make makeinfo
write image information to info files.  From NEWS:

  . makeinfo writes a new construct for @image to the info file, so that
    graphical browsers (such as Emacs Info under X) can display an
    actual image.  Thus, a .txt file substitute is no longer included if
    a real image file is available.

Below is an accompanying patch to emacs' info mode.  The patches and a
small test are also available from

    http://lilypond.org/~jan/info-image

Greetings,
Jan.


Index: lisp/ChangeLog
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.5053
diff -p -u -r1.5053 ChangeLog
--- lisp/ChangeLog	21 Apr 2003 15:43:02 -0000	1.5053
+++ lisp/ChangeLog	21 Apr 2003 16:46:38 -0000
@@ -1,3 +1,10 @@
+2003-04-21  Jan Nieuwenhuizen  <janneke@gnu.org>
+
+	* info.el (Info-unescape-quotes)
+	(Info-split-parameter-string)
+	(Info-display-images-node): New functions for displaying images.
+	(Info-select-node): Call Info-display-images-node.
+
 2003-04-20  Richard M. Stallman  <rms@gnu.org>
 
 	* simple.el (kill-line): Doc fix.
Index: lisp/info.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/info.el,v
retrieving revision 1.342
diff -p -u -r1.342 info.el
--- lisp/info.el	5 Apr 2003 18:01:14 -0000	1.342
+++ lisp/info.el	21 Apr 2003 16:46:40 -0000
@@ -1064,6 +1064,59 @@ a case-insensitive match is tried."
     (if (numberp nodepos)
 	(+ (- nodepos lastfilepos) (point)))))
 
+(defun Info-unescape-quotes (value)
+  "Unescape double quotes and backslashes in VALUE"
+  (let ((start 0)
+	(unquote value))
+    (while (string-match "[^\\\"]*\\(\\\\\\)[\\\\\"]" unquote start)
+      (setq unquote (replace-match "" t t unquote 1))
+      (setq start (- (match-end 0) 1)))
+    unquote))
+
+(defun Info-split-parameter-string (parameter-string)
+  "Return alist of (\"KEY\" . \"VALUE\") from PARAMETER-STRING; a
+   whitespace separated list of KEY=VALUE pairs.  If VALUE
+   contains whitespace or double quotes, it must be quoted in
+   double quotes and any double quotes or backslashes must be
+   escaped (\\\",\\\\)."
+  (let ((start 0)
+	(parameter-alist))
+    (while (string-match
+	    "\\s *\\([^=]+\\)=\\(?:\\([^\\s \"]+\\)\\|\\(?:\"\\(\\(?:[^\\\"]\\|\\\\[\\\\\"]\\)*\\)\"\\)\\)"
+	    parameter-string start)
+      (setq start (match-end 0))
+      (push (cons (match-string 1 parameter-string)
+		  (or (match-string 2 parameter-string)
+		      (Info-unescape-quotes
+		       (match-string 3 parameter-string))))
+	    parameter-alist))
+    parameter-alist))
+
+(defun Info-display-images-node ()
+  "Display images in current node."
+  (save-excursion
+    (let ((inhibit-read-only t)
+	  (case-fold-search t)
+	  paragraph-markers)
+      (goto-char (point-min))
+      (while (re-search-forward
+	      "\\(\0\b[[]image\\(\\(?:[^\b]\\|[^\0]+\b\\)*\\)\0\b[]]\\)"
+	      nil t)
+	(let* ((start (match-beginning 1))
+	       (parameter-alist (Info-split-parameter-string (match-string 2)))
+	       (src (cdr (assoc-string "src" parameter-alist)))
+	       (image-file (if src (if (file-name-absolute-p src) src
+				     (concat default-directory src))
+			     ""))
+	       (image (if (file-exists-p image-file)
+			  (create-image image-file)
+			"[broken image]")))
+	  (message "Found image: %S" image-file)
+	  (if (not (get-text-property start 'display))
+	      (add-text-properties
+	       start (point) `(display ,image rear-nonsticky (display)))))))
+    (set-buffer-modified-p nil)))
+
 (defvar Info-header-line nil
   "If the info node header is hidden, the text of the header.")
 (put 'Info-header-line 'risky-local-variable t)
@@ -1104,6 +1157,7 @@ Bind this in case the user sets it to ni
 	(if Info-enable-active-nodes (eval active-expression))
 	(Info-fontify-node)
 	(setq Info-header-line (get-text-property (point-min) 'header-line))
+	(Info-display-images-node)
 	(run-hooks 'Info-selection-hook)))))
 
 (defun Info-set-mode-line ()

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond - The music typesetter
http://www.xs4all.nl/~jantien       | http://www.lilypond.org

             reply	other threads:[~2003-04-21 16:59 UTC|newest]

Thread overview: 2+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2003-04-21 16:59 Jan Nieuwenhuizen [this message]
2003-04-24  1:50 ` [PATCH]: images for info Richard Stallman

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87fzobkcqd.fsf@peder.flower \
    --to=janneke@gnu.org \
    --cc=karl@freefriends.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).