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
|
;;; proof-compat.el --- Operating system and Emacs version compatibility
;; This file is part of Proof General.
;; Portions © Copyright 1994-2012 David Aspinall and University of Edinburgh
;; Portions © Copyright 2003, 2012, 2014 Free Software Foundation, Inc.
;; Portions © Copyright 2001-2017 Pierre Courtieu
;; Portions © Copyright 2010, 2016 Erik Martin-Dorel
;; Portions © Copyright 2011-2013, 2016-2017 Hendrik Tews
;; Portions © Copyright 2015-2017 Clément Pit-Claudel
;; Author: David Aspinall <David.Aspinall@ed.ac.uk> and others
;; License: GPL (GNU GENERAL PUBLIC LICENSE)
;;; Commentary:
;;
;; 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.
;;
;;; Code:
(require 'easymenu)
(require 'cl)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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.
(with-no-warnings
(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 removing all properties mentioned by custom library.
The symbol itself is left defined, in case it has been changed
in the current Emacs session."
(mapc (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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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))))))
;; 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)))))
;; 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)))))
(provide 'proof-compat)
;;; proof-compat.el ends here
|
