1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
;;; hversion.el --- GNU Hyperbole version and system information setup -*- lexical-binding: t; -*-
;;
;; Author: Bob Weiner
;; Maintainer: Bob Weiner, Mats Lidell
;;
;; Orig-Date: 1-Jan-94
;; Last-Mod: 25-Jun-23 at 11:59:46 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
;;; Commentary:
;;; Code:
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
(require 'hload-path)
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************
(defconst hyperb:version "8.0.1pre" "GNU Hyperbole revision number.")
(defvar hyperb:mouse-buttons
(if (or (and hyperb:microsoft-os-p (not (memq window-system '(w32 w64 x))))
(memq window-system '(ns dps)))
2 3)
"Number of live buttons available on the mouse.
Override this if the system-computed default is incorrect for
your specific mouse.")
;;; ************************************************************************
;;; Public declarations
;;; ************************************************************************
(declare-function br-to-view-window "ext:br")
;;; ************************************************************************
;;; Support functions
;;; ************************************************************************
(defun hyperb:window-sys-term (&optional frame)
"Return first part of the term-type if running under a window system, else nil.
Where a part in the term-type is delimited by a `-' or an `_'."
(unless frame (setq frame (selected-frame)))
(let* ((display-type window-system)
(term (cond ((or (memq display-type '(x gtk mswindows win32 w32 ns dps pm))
;; May be a graphical client spawned from a
;; dumb terminal Emacs, e.g. under X, so if
;; the selected frame has mouse support,
;; then there is a window system to support.
(display-mouse-p))
;; X11, macOS, NEXTSTEP (DPS), or OS/2 Presentation Manager (PM)
"emacs")
;; Keep NeXT as basis for 2-button mouse support
((or (featurep 'eterm-fns)
(equal (getenv "TERM") "NeXT")
(equal (getenv "TERM") "eterm"))
;; NEXTSTEP add-on support to Emacs
"next"))))
(set-frame-parameter frame 'hyperb:window-system term)
term))
(defun hyperb:window-system (&optional frame)
;; FIXME: This apparently can return only "emacs", "next", or nil.
;; What do these things mean? What does "window system available" mean?
;; What does "mouse available mean"?
"Return name of window system or term type where the selected FRAME is running.
If nil after system initialization, no window system or mouse
support is available."
(unless frame (setq frame (selected-frame)))
;; FIXME: Why not compute it on the fly rather than precomputing it
;; via a hook and then saving it as a frame property?
(frame-parameter frame 'hyperb:window-system))
;; Each frame could be on a different window system when under a
;; client-server window system, so set `hyperb:window-system' for
;; each frame.
(mapc #'hyperb:window-sys-term (frame-list))
;; Ensure this next hook is appended so that if follows the hook that
;; selects the new frame.
(add-hook 'after-make-frame-functions #'hyperb:window-sys-term t)
;;; ************************************************************************
;;; Public functions used by pulldown and popup menus
;;; ************************************************************************
(if (not (fboundp 'id-browse-file))
(defalias 'id-browse-file 'view-file))
(unless (fboundp 'id-info)
(defun id-info (string)
(if (stringp string)
(progn (let ((wind (get-buffer-window "*info*")))
(cond (wind (select-window wind))
((br-in-browser) (br-to-view-window))
(t (hpath:display-buffer (other-buffer)))))
;; Force execution of Info-mode-hook which adds the
;; Hyperbole man directory to Info-directory-list.
(info)
(condition-case ()
(Info-goto-node string)
;; If not found as a node, try as an index item.
(error (id-info-item string))))
(error "(id-info): Invalid Info argument, `%s'" string))))
(unless (fboundp 'id-info-item)
(defun id-info-item (index-item)
(if (stringp index-item)
(progn (let ((wind (get-buffer-window "*info*")))
(cond (wind (select-window wind))
((br-in-browser) (br-to-view-window))
(t (hpath:display-buffer (other-buffer)))))
;; Force execution of Info-mode-hook which adds the
;; Hyperbole man directory to Info-directory-list.
(info)
(if (string-match "^(\\([^)]+\\))\\(.*\\)" index-item)
(let ((file (match-string-no-properties 1 index-item))
(item-name (match-string-no-properties 2 index-item)))
(if (and file (setq file (hpath:substitute-value file)))
(progn (Info-goto-node (concat "(" file ")"))
(Info-index item-name))
(Info-goto-node "(hyperbole)")
(Info-index index-item))
;; Index may point to indented line immediately
;; after the non-indented item definition line. If
;; so, move back a line.
(when (and (looking-at "^[ \t]")
(looking-back "^[^ \t].*[\n\r]+" nil))
(forward-line -1))
(recenter 0))
(error "(id-info-item): Invalid Info index item: `%s'" index-item)))
(error "(id-info-item): Info index item must be a string: `%s'" index-item))))
(if (not (fboundp 'id-tool-quit))
(defalias 'id-tool-quit #'eval))
(if (not (fboundp 'id-tool-invoke))
(defun id-tool-invoke (sexp)
(if (commandp sexp)
(call-interactively sexp)
(funcall sexp))))
(provide 'hversion)
;;; hversion.el ends here
|
