1 ;;; dgnushack.el --- a hack to set the load path for byte-compiling
2 ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
3 ;; Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Katsumi Yamaoka <yamaoka@jpl.org>
8 ;; Keywords: news, path
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
31 ;; Set coding priority of Shift-JIS to the bottom.
32 (if (featurep 'xemacs)
33 (defalias 'set-coding-priority 'ignore)
34 (defalias 'coding-priority-list 'ignore)
35 (defalias 'set-coding-priority-list 'ignore))
36 (cond ((and (featurep 'xemacs) (featurep 'mule))
37 (if (memq 'shift-jis (coding-priority-list))
38 (set-coding-priority-list
39 (append (delq 'shift-jis (coding-priority-list)) '(shift-jis)))))
41 (put '*coding-category-sjis* 'priority (length *predefined-category*)))
43 (if (memq 'coding-category-sjis coding-category-list)
45 (append (delq 'coding-category-sjis
46 (copy-sequence coding-category-list))
47 '(coding-category-sjis))))))
49 (defalias 'facep 'ignore)
54 ;; `dolist' might not be available because of ``-no-autoloads''.
56 ;; It may have been defined in egg.el.
58 (load "cl-macs" nil t))
60 (defvar srcdir (or (getenv "srcdir") "."))
62 (defvar dgnushack-w3-directory (let ((w3dir (getenv "W3DIR")))
63 (unless (zerop (length w3dir))
64 (file-name-as-directory w3dir))))
66 (let ((urldir (getenv "URLDIR")))
67 (unless (zerop (length urldir))
68 (setq urldir (file-name-as-directory urldir))
69 (push (file-name-as-directory urldir) load-path))
70 (when (and dgnushack-w3-directory
71 (not (string-equal urldir dgnushack-w3-directory)))
72 (push dgnushack-w3-directory load-path)))
74 ;; If we are building w3 in a different directory than the source
75 ;; directory, we must read *.el from source directory and write *.elc
76 ;; into the building directory. For that, we define this function
77 ;; before loading bytecomp. Bytecomp doesn't overwrite this function.
78 (defun byte-compile-dest-file (filename)
79 "Convert an Emacs Lisp source file name to a compiled file name.
80 In addition, remove directory name part from FILENAME."
81 (setq filename (byte-compiler-base-file-name filename))
82 (setq filename (file-name-sans-versions filename))
83 (setq filename (file-name-nondirectory filename))
84 (if (memq system-type '(win32 w32 mswindows windows-nt))
85 (setq filename (downcase filename)))
86 (cond ((eq system-type 'vax-vms)
87 (concat (substring filename 0 (string-match ";" filename)) "c"))
88 ((string-match emacs-lisp-file-regexp filename)
89 (concat (substring filename 0 (match-beginning 0)) ".elc"))
90 (t (concat filename ".elc"))))
93 ;; To avoid having defsubsts and inlines happen.
94 ;(if (featurep 'xemacs)
95 ; (require 'byte-optimize)
96 ; (require 'byte-opt))
97 ;(defun byte-optimize-inline-handler (form)
98 ; "byte-optimize-handler for the `inline' special-form."
99 ; (cons 'progn (cdr form)))
100 ;(defalias 'byte-compile-file-form-defsubst 'byte-compile-file-form-defun)
102 (when (and (not (featurep 'xemacs))
103 (= emacs-major-version 21)
104 (= emacs-minor-version 3)
106 (let ((byte-compile-error-on-warn t))
107 (byte-optimize-form (quote (pop x)) t)
109 (error (string-match "called for effect"
110 (error-message-string code)))))
111 (defadvice byte-optimize-form-code-walker (around silence-warn-for-pop
114 "Silence the warning \"...called for effect\" for the `pop' form.
115 It is effective only when the `pop' macro is defined by cl.el rather
118 (if (and (eq (car-safe form) 'car)
120 (setq tmp (get 'car 'side-effect-free))
121 (not byte-compile-delete-errors)
122 (not (eq tmp 'error-free))
123 (eq (car-safe (cadr form)) 'prog1)
124 (let ((var (cadr (cadr form)))
125 (last (nth 2 (cadr form))))
127 (null (nthcdr 3 (cadr form)))
128 (eq (car-safe last) 'setq)
130 (eq (car-safe (nth 2 last)) 'cdr)
131 (eq (cadr (nth 2 last)) var))))
133 (put 'car 'side-effect-free 'error-free)
136 (put 'car 'side-effect-free tmp)))
140 (let (current-load-list)
141 ;; Make the function to be silent at compile-time.
142 (defun locate-library (library &optional nosuffix)
143 "Show the full path name of Emacs library LIBRARY.
144 This command searches the directories in `load-path' like `M-x load-library'
145 to find the file that `M-x load-library RET LIBRARY RET' would load.
146 Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el'
147 to the specified name LIBRARY (a la calling `load' instead of `load-library')."
148 (interactive "sLocate library: ")
154 (let ((try (expand-file-name (concat library suf) dir)))
155 (and (file-readable-p try)
156 (null (file-directory-p try))
159 (message "Library is file %s" try))
160 (throw 'answer try)))))
161 (if nosuffix '("") '(".elc" ".el" ""))))
164 (message "No library %s in search path" library))
166 (byte-compile 'locate-library)))
168 (setq max-specpdl-size 3000)
175 (message "The subform `(< 0 1)' should be optimized to t"))
178 (defadvice byte-optimize-form-code-walker
179 (around fix-bug-in-and/or-forms (form for-effect) activate)
180 "Fix a bug in the optimizing and/or forms.
181 It has already been fixed in XEmacs since 1999-12-06."
182 (if (and for-effect (memq (car-safe form) '(and or)))
183 (let ((fn (car form))
184 (backwards (reverse (cdr form))))
185 (while (and backwards
186 (null (setcar backwards
187 (byte-optimize-form (car backwards) t))))
188 (setq backwards (cdr backwards)))
189 (if (and (cdr form) (null backwards))
191 " all subforms of %s called for effect; deleted" form))
194 (mapcar 'byte-optimize-form (cdr backwards))))
195 (setq ad-return-value (cons fn (nreverse backwards))))
200 (wrong-number-of-arguments
201 ;; Optimize byte code for `char-after'.
202 (put 'char-after 'byte-optimizer 'byte-optimize-char-after)
203 (defun byte-optimize-char-after (form)
204 (if (null (cdr form))
205 '(char-after (point))
210 (wrong-number-of-arguments
211 ;; Optimize byte code for `char-before'.
212 (put 'char-before 'byte-optimizer 'byte-optimize-char-before)
213 (defun byte-optimize-char-before (form)
214 (if (null (cdr form))
215 '(char-before (point))
218 (load (expand-file-name "dgnuspath.el" srcdir) nil nil t)
221 (load "~/.lpath.el" t nil t)
222 (error (message "Error in \"~/.lpath.el\" file: %s" err)))
224 ;; Don't load path-util until `char-after' and `char-before' have been
225 ;; optimized because it requires `poe' and then modify the functions.
227 ;; If the APEL modules are installed under the non-standard directory,
228 ;; for example "/var/home/john/lisp/apel-VERSION/", you should add that
229 ;; name using the configure option "--with-addpath=".
230 ;; And also the directory where the EMU modules are installed, for
231 ;; example "/usr/local/share/mule/19.34/site-lisp/", it should be
232 ;; included in the standard `load-path' or added by the configure
233 ;; option "--with-addpath=".
234 (let ((path (or (locate-library "path-util")
235 (locate-library "apel/path-util")));; backward compat.
239 (when (string-match "/$" (setq path (file-name-directory path)))
240 (setq path (substring path 0 (match-beginning 0))))
241 ;; path == "/var/home/john/lisp/apel-VERSION"
242 (when (string-match "/$" (setq parent (file-name-directory path)))
243 (setq parent (substring path 0 (match-beginning 0))))
244 ;; parent == "/var/home/john/lisp"
245 (if (setq lpath (or (member path load-path)
246 (member (file-name-as-directory path) load-path)))
247 (unless (or (member parent load-path)
248 (member (file-name-as-directory parent) load-path))
249 (push parent (cdr lpath)))
250 (push path load-path)
251 (unless (or (member parent load-path)
252 (member (file-name-as-directory parent) load-path))
253 (push parent (cdr load-path))))
255 (require 'path-util))
257 APEL modules are not found in %s.
258 Try to re-configure with --with-addpath=APEL_PATH and run make again.
262 (unless (locate-library "mel")
264 (unless (module-installed-p 'mel)
265 ;; FLIM 1.14 may have installed in two "flim" subdirectories.
266 (push (expand-file-name "flim"
267 (file-name-directory (get-latest-path "^apel$" t)))
269 (unless (module-installed-p 'mel)
271 FLIM modules does not found in %s.
272 Try to re-configure with --with-addpath=FLIM_PATH and run make again.
277 (push srcdir load-path)
278 (load (expand-file-name "lpath.el" srcdir) nil t t)
280 (load (expand-file-name "gnus-clfns.el" srcdir) nil t t)
283 ;; Bind the function `base64-encode-string' before loading canlock.
284 ;; Since canlock will bind it as an autoloaded function, it causes
285 ;; damage to define the function by MEL.
286 (load (expand-file-name "base64.el" srcdir) nil t t)
287 ;; Load special macros for compiling canlock.el.
288 (load (expand-file-name "canlock-om.el" srcdir) nil t t))
292 ;; Bind functions defined by `defun-maybe'.
293 (put 'defun-maybe 'byte-hunk-handler 'byte-compile-file-form-defun-maybe)
294 (defun byte-compile-file-form-defun-maybe (form)
295 (if (and (not (fboundp (nth 1 form)))
296 (memq 'unresolved byte-compile-warnings))
297 (setq byte-compile-function-environment
298 (cons (cons (nth 1 form)
299 (cons 'lambda (cdr (cdr form))))
300 byte-compile-function-environment)))
304 :symbol-for-testing-whether-colon-keyword-is-available-or-not
306 (defun dgnushack-bind-colon-keywords ()
307 "Bind all the colon keywords for old Emacsen."
308 (let ((cache (expand-file-name "dgnuskwds.el" srcdir))
309 (makefile (expand-file-name "Makefile" srcdir))
310 (buffer (get-buffer-create " *colon keywords*"))
311 keywords ignores files file dirs dir form elem make-backup-files)
314 (let (buffer-file-format
316 insert-file-contents-post-hook
317 insert-file-contents-pre-hook
318 jam-zcat-filename-list
319 jka-compr-compression-info-list)
320 (if (and (file-exists-p cache)
321 (file-exists-p makefile)
322 (file-newer-than-file-p cache makefile))
324 (insert-file-contents cache nil nil nil t)
325 (setq keywords (read buffer)))
328 '(:symbol-for-testing-whether-colon-keyword-is-available-or-not
329 ;; The following keywords will be bound by CUSTOM.
330 :get :group :initialize :link :load :options :prefix
331 :require :set :tag :type)
332 files (list (locate-library "semi-def")
333 (locate-library "mailcap")
334 (locate-library "mime-def")
335 (locate-library "path-util")
336 (locate-library "poem"))
337 dirs (list (file-name-as-directory (expand-file-name srcdir))))
339 (when (setq file (pop files))
340 (setq dir (file-name-directory file))
341 (unless (member dir dirs)
343 (message "Searching for all the colon keywords in:")
345 (setq dir (pop dirs))
346 (message " %s..." dir)
347 (setq files (directory-files dir t
348 "\\.el\\(\\.gz\\|\\.bz2\\)?$"))
350 (setq file (pop files))
351 (if (string-match "\\(\\.gz$\\)\\|\\.bz2$" file)
352 (let ((temp (expand-file-name "dgnustemp.el" srcdir)))
354 (let* ((binary (if (boundp 'MULE)
357 (coding-system-for-read binary)
358 (coding-system-for-write binary)
359 (input-coding-system binary)
360 (output-coding-system binary)
361 (default-process-coding-system
362 (cons binary binary))
364 (insert-file-contents file nil nil nil t)
368 (if (match-beginning 1)
370 (point-min) (point-max)
371 "gzip" t buffer nil "-cd")
373 (point-min) (point-max)
374 "bzip2" t buffer nil "-d"))
378 (message "In file %s: %s" file code)
380 (write-region (point-min) (point-max) temp
384 (insert-file-contents temp nil nil nil t)
385 (delete-file temp))))
386 (insert-file-contents file nil nil nil t))
387 (while (setq form (condition-case nil
392 (setq elem (car-safe form)
393 form (cdr-safe form))
394 (unless (memq (car-safe elem)
395 '(defcustom defface defgroup
396 define-widget quote))
398 (push (car elem) form)
399 (setq elem (cdr elem)))
403 (eq ?: (aref (symbol-name elem) 0))
404 (not (memq elem ignores))
405 (not (memq elem keywords)))
406 (push elem keywords))))))))
407 (setq keywords (sort keywords
409 (string-lessp (symbol-name a)
412 (insert (format "%s" keywords))
413 (write-region (point-min) (point) cache nil 'silent)
415 "The following colon keywords will be bound at run-time:\n %s"
418 (defconst dgnushack-colon-keywords keywords)
420 (set (car keywords) (car keywords))
421 (setq keywords (cdr keywords)))))
422 (byte-compile 'dgnushack-bind-colon-keywords)
423 (dgnushack-bind-colon-keywords)))
426 (setq :version ':version
427 :set-after ':set-after)
429 (defadvice custom-handle-keyword
430 (around dont-signal-an-error-even-if-unsupported-keyword-is-given
432 "Don't signal an error even if unsupported keyword is given."
433 (if (not (memq (ad-get-arg 1) '(:version :set-after)))
437 (put 'custom-declare-face 'byte-optimizer
438 'byte-optimize-ignore-unsupported-custom-keywords)
439 (put 'custom-declare-group 'byte-optimizer
440 'byte-optimize-ignore-unsupported-custom-keywords)
441 (defun byte-optimize-ignore-unsupported-custom-keywords (form)
442 (if (or (memq ':version (nthcdr 4 form))
443 (memq ':set-after (nthcdr 4 form)))
444 (let ((newform (list (car form) (nth 1 form)
445 (nth 2 form) (nth 3 form)))
446 (args (nthcdr 4 form)))
448 (or (memq (car args) '(:version :set-after))
449 (setq newform (nconc newform (list (car args)
451 (setq args (cdr (cdr args))))
455 (put 'custom-declare-variable 'byte-hunk-handler
456 'byte-compile-file-form-custom-declare-variable)
457 (defun byte-compile-file-form-custom-declare-variable (form)
458 ;; Bind defcustom'ed variables.
459 (if (memq 'free-vars byte-compile-warnings)
460 (setq byte-compile-bound-variables
461 (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
462 (if (memq ':version (nthcdr 4 form))
463 ;; Make the variable uncustomizable.
464 `(defvar ,(nth 1 (nth 1 form)) ,(nth 1 (nth 2 form))
465 ,(substring (nth 3 form) (if (string-match "^[\t *]+" (nth 3 form))
468 ;; Ignore unsupported keyword(s).
469 (if (memq ':set-after (nthcdr 4 form))
470 (let ((newform (list (car form) (nth 1 form)
471 (nth 2 form) (nth 3 form)))
472 (args (nthcdr 4 form)))
474 (or (eq (car args) ':set-after)
475 (setq newform (nconc newform (list (car args)
477 (setq args (cdr (cdr args))))
481 (defadvice byte-compile-inline-expand (around ignore-built-in-functions
483 "Ignore built-in functions."
484 (let* ((name (car form))
485 (fn (and (fboundp name)
486 (symbol-function name))))
488 ;; Give up on inlining.
489 (setq ad-return-value form)
492 ;; Unknown variables and functions.
493 (unless (boundp 'buffer-file-coding-system)
494 (defvar buffer-file-coding-system (symbol-value 'file-coding-system)))
495 (unless (featurep 'xemacs)
496 (defalias 'Custom-make-dependencies 'ignore)
497 (defalias 'update-autoloads-from-directory 'ignore))
499 (defalias 'device-sound-enabled-p 'ignore)
500 (defalias 'play-sound-file 'ignore)
501 (defalias 'nndb-request-article 'ignore)
502 (defalias 'efs-re-read-dir 'ignore)
503 (defalias 'ange-ftp-re-read-dir 'ignore)
504 (defalias 'define-mail-user-agent 'ignore)
507 (when (featurep 'xemacs)
508 ;; XEmacs 21.1 needs some extra hand holding
509 (when (eq emacs-minor-version 1)
510 (autoload 'custom-declare-face "cus-face" nil t)
511 (autoload 'cl-compile-time-init "cl-macs" nil t)
512 (autoload 'defadvice "advice" nil nil 'macro))
513 (unless (fboundp 'defadvice)
514 (autoload 'defadvice "advice" nil nil 'macro))
515 (autoload 'Info-directory "info" nil t)
516 (autoload 'Info-menu "info" nil t)
517 (autoload 'annotations-at "annotations")
518 (autoload 'apropos "apropos" nil t)
519 (autoload 'apropos-command "apropos" nil t)
520 (autoload 'bbdb-complete-name "bbdb-com" nil t)
521 (autoload 'browse-url "browse-url" nil t)
522 (autoload 'customize-apropos "cus-edit" nil t)
523 (autoload 'customize-save-variable "cus-edit" nil t)
524 (autoload 'customize-variable "cus-edit" nil t)
525 (autoload 'delete-annotation "annotations")
526 (autoload 'dolist "cl-macs" nil nil 'macro)
527 (autoload 'enriched-decode "enriched")
528 (autoload 'info "info" nil t)
529 (autoload 'make-annotation "annotations")
530 (autoload 'make-display-table "disp-table")
532 (autoload 'ps-despool "ps-print" nil t)
533 (autoload 'ps-spool-buffer "ps-print" nil t)
534 (autoload 'ps-spool-buffer-with-faces "ps-print" nil t)
535 (autoload 'read-passwd "passwd")
536 (autoload 'regexp-opt "regexp-opt")
537 (autoload 'reporter-submit-bug-report "reporter")
538 (if (emacs-version>= 21 5)
539 (autoload 'setenv "process" nil t)
540 (autoload 'setenv "env" nil t))
541 (autoload 'smtpmail-send-it "smtpmail")
542 (autoload 'sort-numeric-fields "sort" nil t)
543 (autoload 'sort-subr "sort")
544 (autoload 'trace-function-background "trace" nil t)
545 (autoload 'w3-do-setup "w3")
546 (autoload 'w3-prepare-buffer "w3-display")
547 (autoload 'w3-region "w3-display" nil t)
548 (defalias 'frame-char-height 'frame-height)
549 (defalias 'frame-char-width 'frame-width)
550 (defalias 'frame-parameter 'frame-property)
551 (defalias 'make-overlay 'ignore)
552 (defalias 'overlay-end 'ignore)
553 (defalias 'overlay-get 'ignore)
554 (defalias 'overlay-put 'ignore)
555 (defalias 'overlay-start 'ignore)
556 (defalias 'overlays-in 'ignore)
557 (defalias 'replace-dehighlight 'ignore)
558 (defalias 'replace-highlight 'ignore)
559 (defalias 'run-with-idle-timer 'ignore)
560 (defalias 'w3-coding-system-for-mime-charset 'ignore)))
564 (when (featurep 'xemacs)
565 (autoload 'c-mode "cc-mode" nil t)
566 (autoload 'font-lock-mode "font-lock" nil t)
567 (autoload 'read-kbd-macro "edmacro" nil t)
568 (autoload 'turn-on-font-lock "font-lock" nil t))
569 (autoload 'nnheader-detect-coding-region "nnheader")
570 (autoload 'std11-extract-addresses-components "nnheader")
571 (autoload 'std11-fold-region "nnheader")
572 (autoload 'std11-narrow-to-field "nnheader")
573 (autoload 'std11-unfold-region "nnheader"))
575 (defconst dgnushack-unexporting-files
576 (append '("dgnushack.el" "dgnuspath.el" "dgnuskwds.el" "lpath.el")
577 (unless (or (condition-case code
580 (message "No w3: %s%s, retrying..."
581 (error-message-string code)
582 (if (setq code (locate-library "w3-parse"))
583 (concat " (" code ")")
586 ;; Maybe mis-configured Makefile is used (e.g.
587 ;; configured for FSFmacs but XEmacs is running).
588 (let ((lp (delete dgnushack-w3-directory
589 (copy-sequence load-path))))
590 (if (let ((load-path lp))
594 ;; If success, fix `load-path' for compiling.
597 (message " => fixed; W3DIR=%s"
599 (locate-library "w3-parse")))
601 (message " => ignored")
603 '("nnultimate.el" "webmail.el" "nnwfm.el"))
605 (progn (require 'mh-e) nil)
607 (message "No mh-e: %s%s (ignored)"
608 (error-message-string code)
609 (if (setq code (locate-library "mh-e"))
610 (concat " (" code ")")
614 (progn (require 'xml) nil)
616 (message "No xml: %s%s (ignored)"
617 (error-message-string code)
618 (if (setq code (locate-library "xml"))
619 (concat " (" code ")")
623 (progn (require 'bbdb) nil)
625 (message "No bbdb: %s%s (ignored)"
626 (error-message-string code)
627 (if (setq code (locate-library "bbdb"))
628 (concat " (" code ")")
631 (unless (featurep 'xemacs)
632 '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el"))
633 (when (and (not (featurep 'xemacs))
634 (<= emacs-major-version 20))
636 (when (and (fboundp 'base64-decode-string)
637 (subrp (symbol-function 'base64-decode-string)))
639 (when (and (fboundp 'md5) (subrp (symbol-function 'md5)))
641 (unless (boundp 'MULE)
643 (when (featurep 'xemacs)
645 "Files which will not be installed.")
647 (defconst dgnushack-exporting-files
648 (let ((files (directory-files srcdir nil "^[^=].*\\.el$" t)))
649 (dolist (file dgnushack-unexporting-files)
650 (setq files (delete file files)))
651 (sort files 'string-lessp))
652 "Files which will be compiled and installed.")
654 (defun dgnushack-exporting-files ()
655 "Print name of files which will be installed."
656 (princ (mapconcat 'identity dgnushack-exporting-files " ")))
658 (defconst dgnushack-dont-compile-files
660 "mm-bodies.el" "mm-decode.el" "mm-encode.el" "mm-extern.el"
661 "mm-partial.el" "mm-url.el" "mm-uu.el" "mm-view.el" "mml-sec.el"
662 "mml-smime.el" "mml.el" "mml1991.el" "mml2015.el")
663 "Files which should not be byte-compiled.")
665 (defun dgnushack-compile-verbosely ()
666 "Call dgnushack-compile with warnings ENABLED. If you are compiling
667 patches to gnus, you should consider modifying make.bat to call
668 dgnushack-compile-verbosely. All other users should continue to use
670 (dgnushack-compile t))
672 (defun dgnushack-compile (&optional warn)
673 ;;(setq byte-compile-dynamic t)
674 (when (and (not (featurep 'xemacs))
675 (< emacs-major-version 21))
676 (setq max-specpdl-size 1200))
678 (setq byte-compile-warnings
679 '(free-vars unresolved callargs redefine)))
680 (unless (locate-library "cus-edit")
681 (error "You do not seem to have Custom installed.
682 Fetch it from <URL:http://www.dina.kvl.dk/~abraham/custom/>.
683 You also then need to add the following to the lisp/dgnushack.el file:
685 (push \"~/lisp/custom\" load-path)
687 Modify to suit your needs."))
690 (message "load-path=(\"%s\")"
691 (mapconcat 'identity load-path "\"\n \""))
693 (dolist (file dgnushack-exporting-files)
694 (setq file (expand-file-name file srcdir))
695 (when (and (file-exists-p
696 (setq elc (concat (file-name-nondirectory file) "c")))
697 (file-newer-than-file-p file elc))
700 ;; Avoid barfing (from gnus-xmas) because the etc directory is not yet
702 (when (featurep 'xemacs)
703 (setq gnus-xmas-glyph-directory "dummy"))
705 (let ((files dgnushack-exporting-files)
706 ;;(byte-compile-generate-call-tree t)
708 (while (setq file (pop files))
709 (unless (member file dgnushack-dont-compile-files)
710 (setq file (expand-file-name file srcdir))
711 (when (or (not (file-exists-p
712 (setq elc (concat (file-name-nondirectory file) "c"))))
713 (file-newer-than-file-p file elc))
715 (byte-compile-file file)))))))
717 (defun dgnushack-recompile ()
719 (byte-recompile-directory "." 0))
721 (defvar dgnushack-gnus-load-file
722 (if (featurep 'xemacs)
723 (expand-file-name "auto-autoloads.el" srcdir)
724 (expand-file-name "gnus-load.el" srcdir)))
726 (defvar dgnushack-cus-load-file
727 (if (featurep 'xemacs)
728 (expand-file-name "custom-load.el" srcdir)
729 (expand-file-name "cus-load.el" srcdir)))
731 (defun dgnushack-make-cus-load ()
732 (when (condition-case nil
736 (if (file-exists-p "../contrib/cus-dep.el")
737 ;; Use cus-dep.el of the version of Emacs 20.7.
738 (load-file "../contrib/cus-dep.el")
740 You need contrib/cus-dep.el to build T-gnus with Mule 2.3@19.34; exiting.")))))
741 (let ((cusload-base-file dgnushack-cus-load-file))
742 (if (fboundp 'custom-make-dependencies)
743 (custom-make-dependencies)
744 (Custom-make-dependencies))
745 (when (featurep 'xemacs)
746 (message "Compiling %s..." dgnushack-cus-load-file)
747 (byte-compile-file dgnushack-cus-load-file)))))
749 (defun dgnushack-make-auto-load ()
751 (unless (make-autoload '(define-derived-mode child parent name
754 (defadvice make-autoload (around handle-define-derived-mode activate)
755 "Handle `define-derived-mode'."
756 (if (eq (car-safe (ad-get-arg 0)) 'define-derived-mode)
757 (setq ad-return-value
759 (list 'quote (nth 1 (ad-get-arg 0)))
761 (nth 4 (ad-get-arg 0))
764 (put 'define-derived-mode 'doc-string-elt 3))
765 (let ((generated-autoload-file dgnushack-gnus-load-file)
766 (make-backup-files nil)
767 (autoload-package-name "gnus"))
768 (if (featurep 'xemacs)
769 (if (file-exists-p generated-autoload-file)
770 (delete-file generated-autoload-file))
771 (with-temp-file generated-autoload-file
773 (if (featurep 'xemacs)
774 (let ((si:message (symbol-function 'message)))
775 (defun message (fmt &rest args)
776 (cond ((and (string-equal "Generating autoloads for %s..." fmt)
777 (file-exists-p (file-name-nondirectory (car args))))
779 fmt (file-name-nondirectory (car args))))
780 ((string-equal "No autoloads found in %s" fmt))
781 ((string-equal "Generating autoloads for %s...done" fmt))
782 (t (apply si:message fmt args))))
784 (batch-update-autoloads)
785 (fset 'message si:message)))
786 (batch-update-autoloads))))
788 (defun dgnushack-make-load ()
789 (unless (featurep 'xemacs)
790 (message "Generating %s..." dgnushack-gnus-load-file)
791 (with-temp-file dgnushack-gnus-load-file
792 (insert-file-contents dgnushack-cus-load-file)
793 (delete-file dgnushack-cus-load-file)
794 (goto-char (point-min))
795 (search-forward ";;; Code:")
797 (delete-region (point-min) (point))
799 ;;; gnus-load.el --- automatically extracted custom dependencies and autoload
803 (goto-char (point-max))
804 (if (search-backward "custom-versions-load-alist" nil t)
807 (while (eq (char-after) ?\;)
810 (delete-region (point) (point-max))
812 ;; smiley-* are duplicated. Remove them all.
813 (let ((point (point)))
814 (insert-file-contents dgnushack-gnus-load-file)
816 (while (search-forward "smiley-" nil t)
818 (if (looking-at "(autoload ")
819 (delete-region (point) (progn (forward-sexp) (point)))
822 (goto-char (point-max))
823 (when (search-backward "\n(provide " nil t)
825 (delete-region (point) (point-max)))
828 \(provide 'gnus-load)
831 ;;; version-control: never
832 ;;; no-byte-compile: t
833 ;;; no-update-autoloads: t
835 ;;; gnus-load.el ends here
838 (message "Compiling %s..." dgnushack-gnus-load-file)
839 (byte-compile-file dgnushack-gnus-load-file)
840 (when (featurep 'xemacs)
841 (message "Creating dummy gnus-load.el...")
842 (with-temp-file (expand-file-name "gnus-load.el")
845 \(provide 'gnus-load)
848 ;;; version-control: never
849 ;;; no-byte-compile: t
850 ;;; no-update-autoloads: t
852 ;;; gnus-load.el ends here"))))
855 (defconst dgnushack-info-file-regexp-en
856 (let ((names '("gnus" "message" "emacs-mime"))
858 (while (setq name (pop names))
859 (setq regexp (concat regexp "^" name "\\.info\\(-[0-9]+\\)?$"
860 (when names "\\|"))))
862 "Regexp matching English info files.")
864 (defconst dgnushack-info-file-regexp-ja
865 (let ((names '("gnus-ja" "message-ja"))
867 (while (setq name (pop names))
868 (setq regexp (concat regexp "^" name "\\.info\\(-[0-9]+\\)?$"
869 (when names "\\|"))))
871 "Regexp matching Japanese info files.")
873 (defun dgnushack-remove-extra-files-in-package ()
874 "Remove extra files in the lisp directory of the XEmacs package."
875 (let ((lisp-dir (expand-file-name (concat "lisp/"
877 (cadr command-line-args-left)
880 (car command-line-args-left))))
881 (setq command-line-args-left nil)
882 (when (file-directory-p lisp-dir)
884 (dolist (file dgnushack-exporting-files)
885 (setq files (nconc files (list file (concat file "c")))))
886 (dolist (file (directory-files lisp-dir nil nil t t))
887 (unless (member file files)
888 (setq file (expand-file-name file lisp-dir))
889 (message "Removing %s..." file)
894 (defun dgnushack-install-package-manifest ()
895 "Install MANIFEST file as an XEmacs package."
896 (let* ((package-dir (pop command-line-args-left))
897 (product-name (pop command-line-args-left))
898 (pkginfo-dir (expand-file-name "pkginfo" package-dir))
899 (name (expand-file-name (concat "MANIFEST." product-name)
902 (unless (file-directory-p pkginfo-dir)
903 (message "Creating directory %s/..." pkginfo-dir)
904 (make-directory pkginfo-dir))
905 (message "Generating %s..." name)
907 (insert "pkginfo/MANIFEST." product-name "\n")
908 (let ((lisp-dir (concat "lisp/" product-name "/"))
909 (files (sort (directory-files "." nil "\\.elc?$" t) 'string-lessp))
911 (while (setq file (pop files))
912 (unless (member file dgnushack-unexporting-files)
913 (insert lisp-dir file "\n")))
915 (sort (directory-files "../texi/" nil
916 (concat dgnushack-info-file-regexp-en
918 dgnushack-info-file-regexp-ja)
921 (while (setq file (pop files))
922 (insert "info/" file "\n"))))))
925 (define-compiler-macro describe-key-briefly (&whole form key &optional insert)
926 (if (condition-case nil
928 (describe-key-briefly '((())) nil)
930 (wrong-number-of-arguments nil);; Old Emacsen.
935 (insert (funcall 'describe-key-briefly ,key))
936 (funcall 'describe-key-briefly ,key))
937 `(funcall 'describe-key-briefly ,key))))
939 ;;; dgnushack.el ends here