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
|
;; @(#) ada-support.el --- Override some standard Emacs functions
;; Copyright (C) 1994-1999 Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
;; Maintainer: Emmanuel Briot <briot@gnat.com>
;; Ada Core Technologies's version: $Revision: 1.9 $
;; Keywords: languages ada xref
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;;; This file overrides some functions that are defined in Emacs/XEmacs,
;;; since some of them have known bugs in old versions.
;;; This is intended as a support package for older Emacs versions, and
;;; should not be needed for the latest version of Emacs (currently 20.4)
;;; where these bugs have been fixed
;;;
;;; Note also that all the functions put in this package should be reported
;;; to the FSF for fixed in future versions of Emacs.
;;; Some functions have been renamed from one version to the other
;;; `easy-menu-create-keymaps' has been renamed `easy-menu-create-menu'
;;; from Emacs >= 20.3
;;; Do nothing for XEmacs
(unless (or (ada-check-emacs-version 20 3)
(not (ada-check-emacs-version 1 1 t)))
(if (and (not (fboundp 'easy-menu-create-menu))
(fboundp 'easy-menu-create-keymaps))
(defun easy-menu-create-menu (menu-name menu-items)
"Alias redefined in ada-support.el"
(funcall (symbol-function 'easy-menu-create-keymaps)
menu-name menu-items))))
;;; A fix for Emacs <= 20.3
;;; Imenu does not support name overriding in submenus (the first such name
;;; is always selected, whichever the user actually chose).
;;; This has been fixed in Emacs 20.4
;;; Fix was: use assq instead of assoc in the submenus
(unless (ada-check-emacs-version 20 4)
(defun imenu--mouse-menu (index-alist event &optional title)
"Overrides the default imenu--mouse-menu from imenu.el, that has a bug.
The default one does not know anything about overriding in submenus, since
it is using assoc instead of assq"
(set 'index-alist (imenu--split-submenus index-alist))
(let* ((menu (imenu--split-menu index-alist
(or title (buffer-name))))
position)
(set 'menu (imenu--create-keymap-1 (car menu)
(if (< 1 (length (cdr menu)))
(cdr menu)
(cdr (car (cdr menu))))))
(set 'position (x-popup-menu event menu))
(cond ((eq position nil)
position)
;; If one call to x-popup-menu handled the nested menus,
;; find the result by looking down the menus here.
((and (listp position)
(numberp (car position))
(stringp (nth (1- (length position)) position)))
(let ((final menu))
(while position
(set 'final (assq (car position) final))
(set 'position (cdr position)))
(or (string= (car final)
(car (symbol-value 'imenu--rescan-item)))
(nthcdr 3 final))))
;; If x-popup-menu went just one level and found a leaf item,
;; return the INDEX-ALIST element for that.
((and (consp position)
(stringp (car position))
(null (cdr position)))
(or (string= (car position)
(car (symbol-value 'imenu--rescan-item)))
(assq (car position) index-alist)))
;; If x-popup-menu went just one level
;; and found a non-leaf item (a submenu),
;; recurse to handle the rest.
((listp position)
(imenu--mouse-menu position event
(if title
(concat title
(symbol-value
'imenu-level-separator)
(car (rassq position index-alist)))
(car (rassq position index-alist))))))))
)
;; A fix for the info-mode of speedbar, which by default does not accept
;; a '.' in the name of the node. This is for instance a problem for the
;; Ada95 reference manual.
;; This is still not fixed as of Emacs 20.6
(require 'info)
(defun Info-speedbar-fetch-file-nodes (nodespec)
"Fetch the subnodes from the info NODESPEC.
NODESPEC is a string of the form: (file)node.
Optional THISFILE represends the filename of"
(save-excursion
;; Set up a buffer we can use to fake-out Info.
(set-buffer (get-buffer-create "*info-browse-tmp*"))
(if (not (equal major-mode 'Info-mode))
(Info-mode))
;; Get the node into this buffer
(let ((junk (string-match "^(\\([^)]+\\))\\([^\t ]+\\)$" nodespec))
(file (match-string 1 nodespec))
(node (match-string 2 nodespec)))
(Info-find-node file node))
;; Scan the created buffer
(goto-char (point-min))
(let ((completions nil)
(case-fold-search t)
(thisfile (progn (string-match "^(\\([^)]+\\))" nodespec)
(match-string 1 nodespec))))
;; Always skip the first one...
(re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
(while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
(let ((name (match-string 1)))
(if (looking-at " *\\(([^)]+)[^.\n]+\\)\\.")
(setq name (cons name (match-string 1)))
(if (looking-at " *\\(([^)]+)\\)\\.")
(setq name (cons name (concat (match-string 1) "Top")))
(if (looking-at " \\([^.]+\\).")
(setq name
(cons name (concat "(" thisfile ")" (match-string 1))))
(setq name (cons name (concat "(" thisfile ")" name))))))
(setq completions (cons name completions))))
(nreverse completions))))
(defun Info-speedbar-goto-node (text node indent)
"When user clicks on TEXT, goto an info NODE.
The INDENT level is ignored."
(select-frame speedbar-attached-frame)
(let* ((buff (or (get-buffer "*info*")
(progn (info) (get-buffer "*info*"))))
(bwin (get-buffer-window buff 0)))
(if bwin
(progn
(select-window bwin)
(raise-frame (window-frame bwin)))
(if speedbar-power-click
(let ((pop-up-frames t)) (select-window (display-buffer buff)))
(select-frame speedbar-attached-frame)
(switch-to-buffer buff)))
(let ((junk (string-match "^(\\([^)]+\\))\\([^\t ]+\\)$" node))
(file (match-string 1 node))
(node (match-string 2 node)))
(Info-find-node file node)
;; If we do a find-node, and we were in info mode, restore
;; the old default method. Once we are in info mode, it makes
;; sense to return to whatever method the user was using before.
(if (string= speedbar-initial-expansion-list-name "Info")
(speedbar-change-initial-expansion-list
speedbar-previously-used-expansion-list-name)))))
(provide 'ada-support)
|
