comparison lisp/hyperbole/hypb.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 441bb1e64a06
children 4be1180a9e89
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
4 ;; SUMMARY: Miscellaneous Hyperbole support features. 4 ;; SUMMARY: Miscellaneous Hyperbole support features.
5 ;; USAGE: GNU Emacs Lisp Library 5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: extensions, hypermedia 6 ;; KEYWORDS: extensions, hypermedia
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: InfoDock Associates 9 ;; ORG: Brown U.
10 ;; 10 ;;
11 ;; ORIG-DATE: 6-Oct-91 at 03:42:38 11 ;; ORIG-DATE: 6-Oct-91 at 03:42:38
12 ;; LAST-MOD: 22-Feb-97 at 14:30:10 by Bob Weiner 12 ;; LAST-MOD: 30-Oct-95 at 21:23:19 by Bob Weiner
13 ;; 13 ;;
14 ;; This file is part of Hyperbole. 14 ;; This file is part of Hyperbole.
15 ;; Available for use and distribution under the same terms as GNU Emacs. 15 ;; Available for use and distribution under the same terms as GNU Emacs.
16 ;; 16 ;;
17 ;; Copyright (C) 1991-1995, 1997 Free Software Foundation, Inc. 17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
18 ;; Developed with support from Motorola Inc. 18 ;; Developed with support from Motorola Inc.
19 ;; 19 ;;
20 ;; DESCRIPTION: 20 ;; DESCRIPTION:
21 ;; DESCRIP-END. 21 ;; DESCRIP-END.
22 22
80 cmd-sym keymap 'first))))) 80 cmd-sym keymap 'first)))))
81 (keys (funcall get-keys cmd-sym keymap))) 81 (keys (funcall get-keys cmd-sym keymap)))
82 (concat "{" 82 (concat "{"
83 (if (string= keys "") 83 (if (string= keys "")
84 (concat (funcall get-keys 'execute-extended-command nil) 84 (concat (funcall get-keys 'execute-extended-command nil)
85 " " (symbol-name cmd-sym) " RET") 85 " " (symbol-name cmd-sym) " RTN")
86 keys) 86 keys)
87 "}")) 87 "}"))
88 (error "(hypb:cmd-key-string): Invalid cmd-sym arg: %s." cmd-sym))) 88 (error "(hypb:cmd-key-string): Invalid cmd-sym arg: %s." cmd-sym)))
89 89
90 ;;;###autoload 90 ;;;###autoload
423 purposes. See the documentation of `set-mark' for more information." 423 purposes. See the documentation of `set-mark' for more information."
424 (push-mark location nomsg)) 424 (push-mark location nomsg))
425 ) 425 )
426 426
427 (defun hypb:replace-match-string (regexp str newtext &optional literal) 427 (defun hypb:replace-match-string (regexp str newtext &optional literal)
428 "Replaces all matches for REGEXP in STR with NEWTEXT string and returns the result. 428 "Replaces all matches for REGEXP in STR with NEWTEXT string.
429 Optional LITERAL non-nil means do a literal replacement. 429 Optional LITERAL non-nil means do a literal replacement.
430 Otherwise treat \\ in NEWTEXT string as special: 430 Otherwise treat \\ in NEWTEXT string as special:
431 \\& means substitute original matched text, 431 \\& means substitute original matched text,
432 \\N means substitute match for \(...\) number N, 432 \\N means substitute match for \(...\) number N,
433 \\\\ means insert one \\. 433 \\\\ means insert one \\.
533 "Return non-nil iff OBJ is an Emacs V19 byte compiled object." 533 "Return non-nil iff OBJ is an Emacs V19 byte compiled object."
534 (or (and (fboundp 'compiled-function-p) (compiled-function-p obj)) 534 (or (and (fboundp 'compiled-function-p) (compiled-function-p obj))
535 (and (fboundp 'byte-code-function-p) (byte-code-function-p obj)))) 535 (and (fboundp 'byte-code-function-p) (byte-code-function-p obj))))
536 536
537 ;;; ************************************************************************ 537 ;;; ************************************************************************
538 ;;; About Hyperbole Setup
539 ;;; ************************************************************************
540
541 ;;;###autoload
542 (defun hypb:display-file-with-logo (&optional file)
543 "Display an optional text FILE with the InfoDock Associates logo prepended.
544 Without file, logo is prepended to the current buffer."
545 ;;
546 (if file
547 ;; This function is defined in hversion.el when needed.
548 (id-browse-file file))
549 (if (next-extent (current-buffer))
550 ;; Images have already been inserted, don't do it again.
551 nil
552 (let* ((ida-logo (make-glyph (expand-file-name "ida-logo.xpm" data-directory)))
553 (buffer-read-only)
554 extent)
555 (goto-char (point-min))
556 (indent-to (startup-center-spaces ida-logo))
557 (insert "\n\n")
558 (setq extent (make-extent (- (point) 3) (- (point) 2)))
559 (set-extent-end-glyph extent ida-logo)
560 (set-extent-property extent 'help-echo "Visit InfoDock Associates")
561 (set-extent-property extent 'keymap hypb:ida-logo-keymap))
562 (goto-char (point-min))
563 (skip-syntax-forward "-")
564 (set-window-start (selected-window) 1)
565 (set-buffer-modified-p nil)))
566
567 (defvar hypb:ida-logo-keymap
568 (let ((map (make-sparse-keymap)))
569 (cond (hyperb:emacs19-p
570 (define-key map [button-1] 'hypb:ida-home-page)
571 (define-key map [button-2] 'hypb:ida-home-page)
572 (define-key map "\C-m" 'hypb:ida-home-page))
573 (hyperb:lemacs-p
574 (define-key map 'button1 'hypb:ida-home-page)
575 (define-key map 'button2 'hypb:ida-home-page)
576 (define-key map '(return) 'hypb:ida-home-page)))
577 map)
578 "Keymap used when on the InfoDock Associates logo glyph.")
579
580 (defun hypb:ida-home-page ()
581 "Visit InfoDock Associates home web page."
582 (interactive)
583 (funcall
584 (if (boundp 'highlight-headers-follow-url-function)
585 highlight-headers-follow-url-function
586 'w3-fetch)
587 "http://www.infodock.com/"))
588
589 ;;; ************************************************************************
590 ;;; Private functions 538 ;;; Private functions
591 ;;; ************************************************************************ 539 ;;; ************************************************************************
592 540
593 (defun hypb:oct-to-int (oct-num) 541 (defun hypb:oct-to-int (oct-num)
594 "Returns octal integer OCTAL-NUM converted to a decimal integer." 542 "Returns octal integer OCTAL-NUM converted to a decimal integer."