Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hypb.el @ 100:4be1180a9e89 r20-1b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 131b0175ea99
children cf808b4c4290
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
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: Brown U. 9 ;; ORG: InfoDock Associates
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: 30-Oct-95 at 21:23:19 by Bob Weiner 12 ;; LAST-MOD: 19-Feb-97 at 12:18:08 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, Free Software Foundation, Inc. 17 ;; Copyright (C) 1991-1995, 1997 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) " RTN") 85 " " (symbol-name cmd-sym) " RET")
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. 428 "Replaces all matches for REGEXP in STR with NEWTEXT string and returns the result.
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 (define-key map 'button1 'hypb:ida-home-page)
570 (define-key map 'button2 'hypb:ida-home-page)
571 (define-key map '(return) 'hypb:ida-home-page)
572 map)
573 "Keymap used when on the InfoDock Associates logo glyph.")
574
575 (defun hypb:ida-home-page ()
576 "Visit InfoDock Associates home web page."
577 (interactive)
578 (funcall
579 (if (boundp 'highlight-headers-follow-url-function)
580 highlight-headers-follow-url-function
581 'w3-fetch)
582 "http://www.infodock.com/"))
583
584 ;;; ************************************************************************
538 ;;; Private functions 585 ;;; Private functions
539 ;;; ************************************************************************ 586 ;;; ************************************************************************
540 587
541 (defun hypb:oct-to-int (oct-num) 588 (defun hypb:oct-to-int (oct-num)
542 "Returns octal integer OCTAL-NUM converted to a decimal integer." 589 "Returns octal integer OCTAL-NUM converted to a decimal integer."