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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
;; proof-compat.el Operating system and Emacs version compatibility
;;
;; Copyright (C) 2000-2009 LFCS Edinburgh.
;; Author: David Aspinall <David.Aspinall@ed.ac.uk> and others
;; License: GPL (GNU GENERAL PUBLIC LICENSE)
;;
;; $Id$
;;
;; This file collects together compatibility hacks for different
;; operating systems and Emacs versions. This is to help keep
;; track of them.
;;
;; The development policy for Proof General (since v3.7) is for the
;; main codebase to be written for the latest stable version of
;; GNU Emacs, following GNU Emacs advice on obsolete function calls.
;;
;; Since Proof General 4.0, XEmacs is not supported at all.
;;
(eval-when-compile
(require 'cl)
(require 'easymenu))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Architecture flags
;;;
;; can use eval-and-compile to allow optimisation, but that would
;; require recompilation for Windows
(defvar proof-running-on-win32 (memq system-type '(win32 windows-nt cygwin))
"Non-nil if Proof General is running on a windows variant system.")
;; Workaround a small bug in Carbon Emacs Winter 2008 (at least)
;; Menu presses query this variable, but it's not bound unless
;; mode engaged. Not noticeable in normal use, but it is as soon
;; as debug-on-error is engaged.
(if (and (boundp 'carbon-emacs-package-version)
(not (boundp 'mac-key-mode)))
(setq mac-key-mode nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Modifications and adjustments
;;;
;; Remove a custom setting. Needed to support dynamic reconfiguration.
;; (We'd prefer that repeated defcustom calls acted like repeated
;; "defvar treated as defconst" in XEmacs)
(defun pg-custom-undeclare-variable (symbol)
"Remove a custom setting SYMBOL.
Done by `makunbound' and removing all properties mentioned by custom library."
(mapcar (lambda (prop) (remprop symbol prop))
'(default
standard-value
force-value
variable-comment
saved-variable-comment
variable-documentation
group-documentation
custom-set
custom-get
custom-options
custom-requests
custom-group
custom-prefix
custom-tag
custom-links
custom-version
saved-value
theme-value
theme-face))
(makunbound symbol))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; GNU Emacs compatibility with XEmacs
;;;
(unless (fboundp 'save-selected-frame)
(defmacro save-selected-frame (&rest body)
"Execute forms in BODY, then restore the selected frame.
The value returned is the value of the last form in BODY."
(let ((old-frame (gensym "ssf")))
`(let ((,old-frame (selected-frame)))
(unwind-protect
(progn ,@body)
(select-frame ,old-frame))))))
;; Replace in string: XEmacs original now in GNU Emacs as replace-regexp-in-string
(or (fboundp 'replace-in-string)
(defun replace-in-string (str regexp newtext &optional literal)
(replace-regexp-in-string regexp newtext str 'fixedcase literal)))
;; An implemenation of buffer-syntactic-context for GNU Emacs
(defun proof-buffer-syntactic-context-emulate (&optional buffer)
"Return the syntactic context of BUFFER at point.
If BUFFER is nil or omitted, the current buffer is assumed.
The returned value is one of the following symbols:
nil ; meaning no special interpretation
string ; meaning point is within a string
comment ; meaning point is within a line comment"
(save-excursion
(if buffer (set-buffer buffer))
(let ((pp (parse-partial-sexp (point-min) (point))))
(cond
((nth 3 pp) 'string)
;; ((nth 7 pp) 'block-comment)
;; "Stefan Monnier" <monnier+misc/news@rum.cs.yale.edu> suggests
;; distinguishing between block comments and ordinary comments
;; is problematic: not what XEmacs claims and different to what
;; (nth 7 pp) tells us in GNU Emacs.
((nth 4 pp) 'comment)))))
;; In case Emacs is not aware of the function read-shell-command,
;; we duplicate some code adjusted from minibuf.el distributed
;; with XEmacs 21.1.9. Bothering with this just to give completion for
;; when proof-prog-name-ask=t is a bit of an overkill!
;; Still, now it's here we'll leave it in as a pleasant surprise.
;;
(or (fboundp 'read-shell-command)
(defvar read-shell-command-map
(let ((map (make-sparse-keymap 'read-shell-command-map)))
(if (fboundp 'set-keymap-parents)
;; XEmacs versions without read-shell-command?
(set-keymap-parents map minibuffer-local-map)
(if (fboundp 'set-keymap-parent)
;; GNU Emacs 20.2
(set-keymap-parent map minibuffer-local-map)
;; Earlier GNU Emacs
(setq map (append minibuffer-local-map map))))
(define-key map "\t" 'comint-dynamic-complete)
(define-key map "\M-\t" 'comint-dynamic-complete)
(define-key map "\M-?" 'comint-dynamic-list-completions)
map)
"Minibuffer keymap used by `shell-command' and related commands."))
(or (fboundp 'read-shell-command)
(defun read-shell-command (prompt &optional initial-input history)
"Just like read-string, but uses read-shell-command-map:
\\{read-shell-command-map}"
(let ((minibuffer-completion-table nil))
(read-from-minibuffer prompt initial-input read-shell-command-map
nil (or history 'shell-command-history)))))
(or (fboundp 'frames-of-buffer)
;; From XEmacs 21.4.12, aliases expanded
(defun frames-of-buffer (&optional buffer visible-only)
"Return list of frames that BUFFER is currently being displayed on.
If the buffer is being displayed on the currently selected frame, that frame
is first in the list. VISIBLE-ONLY will only list non-iconified frames."
(let ((list (get-buffer-window-list buffer))
(cur-frame (selected-frame))
next-frame frames save-frame)
(while list
(if (memq (setq next-frame (window-frame (car list)))
frames)
nil
(if (eq cur-frame next-frame)
(setq save-frame next-frame)
(and
(or (not visible-only)
(frame-visible-p next-frame))
(setq frames (append frames (list next-frame))))))
(setq list (cdr list)))
(if save-frame
(append (list save-frame) frames)
frames))))
;; These functions are used in the intricate logic around
;; shrink-to-fit.
;; window-leftmost-p, window-rightmost-p: my implementations
(or (fboundp 'window-leftmost-p)
(defun window-leftmost-p (window)
(zerop (car (window-edges window)))))
(or (fboundp 'window-rightmost-p)
(defun window-rightmost-p (window)
(>= (nth 2 (window-edges window))
(frame-width (window-frame window)))))
(or (fboundp 'window-bottom-p)
(defun window-bottom-p (window)
(>= (nth 3 (window-edges window))
(frame-height (window-frame window)))))
;; with-selected-window from XEmacs 21.4.12
(or (fboundp 'with-selected-window)
(defmacro with-selected-window (window &rest body)
"Execute forms in BODY with WINDOW as the selected window.
The value returned is the value of the last form in BODY."
`(save-selected-window
(select-window ,window)
,@body)))
;; find-coding-system emulation for GNU Emacs
(unless (fboundp 'find-coding-system)
(defun find-coding-system (name)
"Retrieve the coding system of the given name, or nil if non-such."
(condition-case nil
(check-coding-system name)
(error nil))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; A naughty hack to completion.el
;;;
;;; At the moment IMO completion too eagerly adds stuff to
;;; its database: the completion-before-command function
;;; makes every suffix be added as a completion!
(eval-after-load "completion"
'(defun completion-before-command ()
(if (and (symbolp this-command) (get this-command 'completion-function))
(funcall (get this-command 'completion-function)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; General Emacs version compatibility
;;;
(defalias 'proof-buffer-syntactic-context
'proof-buffer-syntactic-context-emulate)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Nasty: Emacs bug/problem fix section
;;;
;; End of proof-compat.el
(provide 'proof-compat)
|
