81
84
(silentcomp-defun thing-boundaries)
82
85
(silentcomp-defun thing-symbol)
87
(silentcomp-defun custom-file)
86
90
(defconst ecb-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
87
91
(defconst ecb-running-emacs-21 (and (not ecb-running-xemacs)
88
92
(> emacs-major-version 20)))
90
(defconst ecb-directory-sep-char ?/)
94
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: Test this with native
95
;; Windows-XEmacs if it works with this change correct and also if it works
96
;; without this change incorrect!
97
(defconst ecb-directory-sep-char
98
(if ecb-running-xemacs directory-sep-char ?/))
91
99
(defconst ecb-directory-sep-string (char-to-string ecb-directory-sep-char))
93
101
(defconst ecb-temp-dir
125
133
(display-images-p)
136
;; -------------------------------------------------------------------
137
;; Tracing - currently not used because we use the trace.el library!
138
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: Offer conveniant wrappers for the
139
;; trace-function-background stuff so users can easily trace a set of
140
;; ecb-functions if there occur problems where a backtrace can not be
143
(defvar ecb-trace-defun-enter t)
144
(defvar ecb-trace-defun-leave t)
146
(defsubst ecb-defun-trace (mode fcn)
147
(cond ((equal mode 'enter)
148
(and ecb-trace-defun-enter
149
(message "ECB-function %S entered!" fcn)))
151
(and ecb-trace-defun-leave
152
(message "ECB-function %S leaved!" fcn)))))
154
(defmacro ecb-defun (name args docstring &rest body)
158
,@(if (not (equal (caar body) 'interactive))
159
(append (list `(ecb-defun-trace 'enter (quote ,name)))
162
(ecb-defun-trace 'leave (quote ,name)))))
163
(append (list (car body))
164
(list `(ecb-defun-trace 'enter (quote ,name)))
167
(ecb-defun-trace 'leave (quote ,name)))))))))
170
;; -------------------------------------------------------------------
128
173
;; ---------- compatibility between GNU Emacs and XEmacs ---------------------
130
175
;; miscellaneous differences
148
195
(defalias 'ecb-frame-parameter 'frame-property)
149
196
(defalias 'ecb-line-beginning-pos 'point-at-bol)
150
197
(defalias 'ecb-line-end-pos 'point-at-eol)
198
(defalias 'ecb-event-window 'event-window)
199
(defalias 'ecb-event-point 'event-point)
200
(defalias 'ecb-event-buffer 'event-buffer)
151
201
(defalias 'ecb-window-full-width 'window-full-width)
152
202
(defalias 'ecb-window-full-height 'window-height)
153
203
(defun ecb-frame-char-width (&optional frame)
161
211
(/ (nth 2 pix-edges) (ecb-frame-char-width))
162
212
(/ (nth 3 pix-edges) (ecb-frame-char-height))))))
214
(defalias 'ecb-facep 'facep)
164
215
(defun ecb-noninteractive ()
165
216
"Return non-nil if running non-interactively, i.e. in batch mode."
167
218
(defalias 'ecb-subst-char-in-string 'subst-char-in-string)
168
(defalias 'ecb-thing-at-point 'thing-at-point)
169
219
(defalias 'ecb-frame-parameter 'frame-parameter)
170
220
(defalias 'ecb-line-beginning-pos 'line-beginning-position)
171
221
(defalias 'ecb-line-end-pos 'line-end-position)
222
(defun ecb-event-window (event)
223
(posn-window (event-start event)))
224
(defun ecb-event-point (event)
225
(posn-point (event-start event)))
226
(defun ecb-event-buffer (event)
227
(window-buffer (ecb-event-window event)))
172
228
(defun ecb-window-full-width (&optional window)
173
229
(let ((edges (window-edges window)))
174
230
(- (nth 2 edges) (nth 0 edges))))
239
295
;; ---------- End of compatibility between GNU Emacs and XEmacs -------------
297
(if (fboundp 'compare-strings)
298
(defalias 'ecb-compare-strings 'compare-strings)
299
(defun ecb-compare-strings (str1 start1 end1 str2 start2 end2 &optional ignore-case)
300
"Compare the contents of two strings.
301
In string STR1, skip the first START1 characters and stop at END1.
302
In string STR2, skip the first START2 characters and stop at END2.
303
END1 and END2 default to the full lengths of the respective strings.
305
Case is significant in this comparison if IGNORE-CASE is nil.
307
The value is t if the strings (or specified portions) match.
308
If string STR1 is less, the value is a negative number N;
309
- 1 - N is the number of characters that match at the beginning.
310
If string STR1 is greater, the value is a positive number N;
311
N - 1 is the number of characters that match at the beginning."
312
(or start1 (setq start1 0))
313
(or start2 (setq start2 0))
315
(min end1 (length str1))
318
(min end2 (length str2))
323
(while (and (not result) (< i1 end1) (< i2 end2))
324
(setq c1 (aref str1 i1)
331
(setq result (cond ((< c1 c2) (- i1))
334
(cond ((< i1 end1) (1+ (- i1 start1)))
335
((< i2 end2) (1- (- start1 i1)))
339
(defsubst ecb-string= (str1 str2 &optional ignore-case)
340
(let ((s1 (or (and (stringp str1) str1) (symbol-name str1)))
341
(s2 (or (and (stringp str2) str2) (symbol-name str2))))
342
(eq (ecb-compare-strings s1 nil nil s2 nil nil ignore-case) t)))
344
(defsubst ecb-string< (str1 str2 &optional ignore-case)
345
(let ((s1 (or (and (stringp str1) str1) (symbol-name str1)))
346
(s2 (or (and (stringp str2) str2) (symbol-name str2)))
348
(setq result (ecb-compare-strings s1 nil nil s2 nil nil ignore-case))
349
(and (numberp result) (< result 0))))
241
351
;; Emacs 20 has no window-list function and the XEmacs and Emacs 21 one has no
242
352
;; specified ordering. The following one is stolen from XEmacs and has fixed
243
353
;; this lack of a well defined order. We preserve also point of current
390
498
;; some basic advices
500
(defun ecb-custom-file ()
501
"Filename of that file which is used by \(X)Emacs to store the
503
(cond (ecb-running-xemacs
505
(ecb-running-emacs-21
392
511
(defadvice custom-save-all (around ecb)
393
512
"Save the customized options completely in the background, i.e. the
394
513
file-buffer where the value is saved \(see option `custom-file') is not parsed
395
514
by semantic and also killed afterwards."
396
515
(if ecb-minor-mode
397
(let ((ecb-window-sync nil)
516
(let (;; XEmacs 21.4 does not set this so we do it here, to ensure that
517
;; the custom-file is loadede in an emacs-lisp-mode buffer, s.b.
518
(default-major-mode 'emacs-lisp-mode)
519
(ecb-window-sync nil)
398
520
(kill-buffer-hook nil)
399
521
;; we prevent parsing the custom-file
400
522
(semantic-before-toplevel-bovination-hook (lambda ()
524
(semantic--before-fetch-tags-hook (lambda ()
402
526
(semantic-after-toplevel-cache-change-hook nil)
403
527
(semantic-after-partial-cache-change-hook nil))
404
;; now we do the standard task
528
;; Klaus Berndl <klaus.berndl@sdm.de>: we must ensure that the
529
;; current-buffer has a lisp major-mode when the kernel of
530
;; `custom-save-all' is called because cause of a bug (IMHO) in the
531
;; `custom-save-delete' of GNU Emacs (which loads the file returned by
532
;; `custom-file' with `default-major-mode' set to nil which in turn
533
;; causes that new buffer will get the major-mode of the
534
;; current-buffer) the file `custom-file' will get the major-mode of
535
;; the current-buffer. So when the current-buffer has for example
536
;; major-mode `c++-mode' then the file `custom-file' will be loaded
537
;; into a buffer with major-mode c++-mode. The function
538
;; `custom-save-delete' then parses this buffer with (forward-sexp
539
;; (buffer-size)) which of course fails because forward-sexp tries to
540
;; parse the custom-file (which is an emacs-lisp-file) as a c++-file
541
;; with c++-paren-syntax.
542
;; Solution: Ensure that the buffer *scratch* is current when calling
543
;; custom-save-all so we have surely a lispy-buffer and therefore we
544
;; can be sure that custom-file is loaded as lispy-buffer.
546
(set-buffer (get-buffer-create "*scratch*"))
547
;; now we do the standard task
406
549
;; now we have to kill the custom-file buffer otherwise semantic would
407
550
;; parse the buffer of custom-file and the method-buffer would be
408
551
;; updated with the contents of custom-file which is definitely not
411
(kill-buffer (find-file-noselect (cond (ecb-running-xemacs
413
(ecb-running-emacs-21
417
user-init-file)))))))
554
(kill-buffer (find-file-noselect (ecb-custom-file)))))
492
630
(member item list)
493
631
(memq item list)))
633
(defsubst ecb-match-regexp-list (str regexp-list &optional elem-accessor
635
"Return not nil if STR matches one of the regexps in REGEXP-LIST. If
636
ELEM-ACCESSOR is a function then it is used to get the regexp from the
637
processed elem of REGEXP-LIST. If nil the elem itself is used. If
638
RETURN-ACCESSOR is a function then it is used to get from the matching elem
639
the object to return. If nil then the matching elem itself is returned."
640
(let ((elem-acc (or elem-accessor 'identity))
641
(return-acc (or return-accessor 'identity)))
643
(dolist (elem regexp-list)
644
(let ((case-fold-search t))
646
(if (string-match (funcall elem-acc elem) str)
647
(throw 'exit (funcall return-acc elem))))
495
651
(defun ecb-set-elt (seq n val)
496
652
"Set VAL as new N-th element of SEQ. SEQ can be any sequence. SEQ will be
498
(if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
653
changed because this is desctructive function. SEQ is returned."
655
(setcar (nthcdr n seq) val)
659
(defun ecb-replace-first-occurence (seq old-elem new-elem)
660
"Replace in SEQ the first occurence of OLD-ELEM with NEW-ELEM. Comparison is
661
done by `equal'. This is desctructive function. SEQ is returned."
662
(let ((pos (ecb-position seq old-elem)))
664
(ecb-set-elt seq pos new-elem)))
667
(defun ecb-replace-all-occurences (seq old-elem new-elem)
668
"Replace in SEQ all occurences of OLD-ELEM with NEW-ELEM. Comparison is
669
done by `equal'. This is desctructive function. SEQ is returned."
670
(while (ecb-position seq old-elem)
671
(setq seq (ecb-replace-first-occurence seq old-elem new-elem)))
674
(defun ecb-remove-first-occurence-from-list (list elem)
675
"Replace first occurence of ELEM from LIST. Comparison is done by `equal'.
676
This is desctructive function. LIST is returned."
677
(delq nil (ecb-replace-first-occurence list elem nil)))
679
(defun ecb-remove-all-occurences-from-list (list elem)
680
"Replace all occurences of ELEM from LIST. Comparison is done by `equal'.
681
This is desctructive function. LIST is returned."
684
(while (ecb-position list elem)
685
(setq list (ecb-replace-first-occurence list elem nil)))
500
688
;; canonical filenames
690
(defun ecb-fix-path (path)
691
"Fixes an annoying behavior of the native windows-version of XEmacs:
692
When PATH contains only a drive-letter and a : then `expand-file-name' does
693
not interpret this PATH as root of that drive. So we add a trailing
694
`directory-sep-char' and return this new path because then `expand-file-name'
695
treats this as root-dir of that drive. For all \(X)Emacs-version besides the
696
native-windows-XEmacs PATH is returned."
697
(if (and ecb-running-xemacs
698
(equal system-type 'windows-nt))
699
(if (and (= (length path) 2)
700
(equal (aref path 1) ?:))
701
(concat path ecb-directory-sep-string)
705
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: What about the new cygwin-version
706
;; of GNU Emacs 21? We have to test if this function and all locations where
707
;; `ecb-fix-path' is used work correctly with the cygwin-port of GNU Emacs.
502
708
(defun ecb-fix-filename (path &optional filename substitute-env-vars)
503
709
"Normalizes path- and filenames for ECB. If FILENAME is not nil its pure
504
710
filename \(i.e. without directory part) will be concatenated to PATH. The
506
712
not nil then in both PATH and FILENAME env-var substitution is done. If the
507
713
`system-type' is 'cygwin32 then the path is converted to win32-path-style!"
508
714
(when (stringp path)
510
(setq norm-path (if (and ecb-running-xemacs (equal system-type 'cygwin32))
511
(mswindows-cygwin-to-win32-path path)
716
(setq norm-path (if ecb-running-xemacs
717
(cond ((equal system-type 'cygwin32)
718
(mswindows-cygwin-to-win32-path
719
(expand-file-name path)))
720
((equal system-type 'windows-nt)
721
(expand-file-name (ecb-fix-path path)))
722
(t (expand-file-name path)))
723
(expand-file-name path)))
724
;; For windows systems we normalize drive-letters to downcase
725
(setq norm-path (if (and (member system-type '(windows-nt cygwin32))
726
(> (length norm-path) 1)
727
(equal (aref norm-path 1) ?:))
728
(concat (downcase (substring norm-path 0 2))
729
(substring norm-path 2))
731
;; substitute environment-variables
513
732
(setq norm-path (expand-file-name (if substitute-env-vars
514
733
(substitute-in-file-name norm-path)
735
;; delete a trailing directory-separator if there is any
516
736
(setq norm-path (if (and (> (length norm-path) 1)
517
737
(= (aref norm-path
518
738
(1- (length norm-path))) ecb-directory-sep-char))
799
1019
(defun ecb-merge-face-into-text (text face)
800
1020
"Merge FACE to the already precolored TEXT so the values of all
801
1021
face-attributes of FACE take effect and but the values of all face-attributes
802
of TEXT which are not set by FACE are preserved.
803
For XEmacs this merge does currently not work therefore here FACE replaces all
1022
of TEXT which are not set by FACE are preserved."
807
(let ((newtext (concat text)))
808
(if ecb-running-xemacs
809
(add-text-properties 0 (length newtext) (list 'face face) newtext)
810
(alter-text-property 0 (length newtext) 'face
811
(lambda (current-face)
813
(cond ((facep current-face)
815
((listp current-face)
824
;; we must add the new-face in front of
825
;; current-face to get the right merge!
1025
(if ecb-running-xemacs
1026
(put-text-property 0 (length text) 'face
1027
(let* ((current-face (get-text-property 0
1031
(cond ((ecb-facep current-face)
1032
(list current-face))
1033
((listp current-face)
1037
(cond ((ecb-facep face)
1042
;; we must add the new-face in front of
1043
;; current-face to get the right merge!
1046
(alter-text-property 0 (length text) 'face
1047
(lambda (current-face)
1049
(cond ((ecb-facep current-face)
1050
(list current-face))
1051
((listp current-face)
1055
(cond ((ecb-facep face)
1060
;; we must add the new-face in front of
1061
;; current-face to get the right merge!
831
1066
(defun ecb-error (&rest args)
832
1067
"Signals an error but prevents it from entering the debugger. This is
995
1231
;; (if (not (sit-for timeout)) (read-event))
998
(defun ecb-position (list elem)
999
"Return the position of ELEM within LIST counting from 0. Comparison is done
1234
(defun ecb-position (seq elem)
1235
"Return the position of ELEM within SEQ counting from 0. Comparison is done
1001
(let ((pos (1- (length (member elem (reverse list))))))
1238
(let ((pos (- (length seq) (length (member elem seq)))))
1239
(if (= pos (length seq))
1243
(dotimes (i (length seq))
1244
(if (equal elem (aref seq i))
1248
(defun ecb-last (seq)
1249
"Return the last elem of the sequence SEQ."
1253
(aref seq (1- (length seq)))
1256
(defun ecb-first (seq)
1257
"Return the first elem of the sequence SEQ."
1006
1265
(defun ecb-next-listelem (list elem &optional nth-next)
1007
1266
"Return that element of LIST which follows directly ELEM when ELEM is an
1284
(defun ecb-buffer-name (buffer-or-name)
1285
"Return the buffer-name of BUFFER-OR-NAME."
1286
(cond ((stringp buffer-or-name)
1288
((bufferp buffer-or-name)
1289
(buffer-name buffer-or-name))
1293
(defun ecb-buffer-obj (buffer-or-name)
1294
"Return the buffer-object of BUFFER-OR-NAME."
1295
(cond ((stringp buffer-or-name)
1296
(get-buffer buffer-or-name))
1297
((bufferp buffer-or-name)
1025
1302
(defun ecb-file-content-as-string (file)
1026
1303
"If FILE exists and is readable returns the contents as a string otherwise
1057
1334
(ecb-current-buffer-archive-extract-p))
1058
1335
(ecb-current-buffer-archive-extract-p))))))
1060
(defun ecb-fit-str-to-width (str width)
1061
"If STR is longer than WIDTH then fit it to WIDTH by stripping from left and
1062
prepend \"...\" to signalize that the string is stripped. If WIDTH >= length
1337
(defun ecb-fit-str-to-width (str width from)
1338
"If STR is longer than WIDTH then fit it to WIDTH by stripping from left or
1339
right \(depends on FROM which can be 'left or 'right) and prepend \(rsp.
1340
append) \"...\" to signalize that the string is stripped. If WIDTH >= length
1063
1341
of STR the always STR is returned. If either WIDTH or length of STR is < 5
1064
1342
then an empty string is returned because stripping makes no sense here."
1065
1343
(let ((len-str (length str)))
1130
1412
(defun ecb-ring-elements (ring)
1131
1413
"Return a list of the lements of RING."
1132
1414
(mapcar #'identity (cddr ring)))
1416
(defvar ecb-max-submenu-depth 4
1417
"The maximum depth of nesting submenus for the tree-buffers.")
1419
(defun ecb-create-menu-user-ext-type (curr-level max-level)
1420
"Creates the :type-definition for the *-menu-user-extension options.
1421
This allows nested submenus for the popup-menus of the tree-buffers up to a
1422
maximum level of MAX-LEVEL. CURR-LEVEL must be 1 when used in a
1423
defcustom-clause and has to be <= MAX-LEVEL."
1424
(list 'repeat (delq nil
1425
(list 'choice ':tag "Menu-entry" ':menu-tag "Menu-entry"
1426
':value '(ignore "")
1427
(list 'const ':tag "Separator" ':value '("---"))
1428
(list 'list ':tag "Menu-command"
1429
(list 'function ':tag "Function" ':value 'ignore)
1430
(list 'string ':tag "Entry-name"))
1431
(if (= curr-level max-level)
1433
(list 'cons ':tag "Submenu"
1434
(list 'string ':tag "Submenu-title")
1435
(ecb-create-menu-user-ext-type (1+ curr-level)
1135
1437
(silentcomp-provide 'ecb-util)
1137
1439
;;; ecb-util.el ends here
added
removed
ecb-util.el
