* [PATCH]: images for info
@ 2003-04-21 16:59 Jan Nieuwenhuizen
2003-04-24 1:50 ` Richard Stallman
0 siblings, 1 reply; 2+ messages in thread
From: Jan Nieuwenhuizen @ 2003-04-21 16:59 UTC (permalink / raw)
Cc: karl
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
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2003-04-24 1:50 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2003-04-21 16:59 [PATCH]: images for info Jan Nieuwenhuizen
2003-04-24 1:50 ` Richard Stallman
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).