cgit.sxemacs.org Git - gnus/blob - lisp/dgnushack.el

   1 ;;; dgnushack.el --- a hack to set the load path for byte-compiling
   2 ;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;; Version: 4.19
   6 ;; Keywords: news, path
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (defvar dgnushack-default-load-path (copy-sequence load-path))
  28
  29 (unless (fboundp 'declare-function)
  30   (defmacro declare-function (&rest r)))
  31
  32 (defalias 'facep 'ignore)
  33
  34 (require 'cl)
  35 (require 'iswitchb)
  36
  37 (condition-case nil
  38     (require 'org-entities)
  39   (error nil))
  40
  41 (defvar srcdir (or (getenv "srcdir") "."))
  42 (defvar loaddir (and load-file-name (file-name-directory load-file-name)))
  43
  44 (defun my-getenv (str)
  45   (let ((val (getenv str)))
  46     (if (equal val "no") nil val)))
  47
  48 (if (my-getenv "lispdir")
  49     (push (my-getenv "lispdir") load-path))
  50
  51 ;(push "/usr/share/emacs/site-lisp" load-path)
  52
  53 ;; If we are building Gnus in a different directory than the source
  54 ;; directory, we must read *.el from source directory and write *.elc
  55 ;; into the building directory.  For that, we define this function
  56 ;; before loading bytecomp.  Bytecomp doesn't overwrite this function.
  57 (defun byte-compile-dest-file (filename)
  58   "Convert an Emacs Lisp source file name to a compiled file name.
  59  In addition, remove directory name part from FILENAME."
  60   (setq filename (byte-compiler-base-file-name filename))
  61   (setq filename (file-name-sans-versions filename))
  62   (setq filename (file-name-nondirectory filename))
  63   (if (eq system-type 'windows-nt)
  64       (setq filename (downcase filename)))
  65   (cond ((eq system-type 'vax-vms)
  66          (concat (substring filename 0 (string-match ";" filename)) "c"))
  67         ((string-match emacs-lisp-file-regexp filename)
  68          (concat (substring filename 0 (match-beginning 0)) ".elc"))
  69         (t (concat filename ".elc"))))
  70
  71 (require 'bytecomp)
  72 ;; To avoid having defsubsts and inlines happen.
  73 ;(if (featurep 'xemacs)
  74 ;    (require 'byte-optimize)
  75 ;  (require 'byte-opt))
  76 ;(defun byte-optimize-inline-handler (form)
  77 ;  "byte-optimize-handler for the `inline' special-form."
  78 ;  (cons 'progn (cdr form)))
  79 ;(defalias 'byte-compile-file-form-defsubst 'byte-compile-file-form-defun)
  80
  81 ;; Work around for an incompatibility (XEmacs 21.4 vs. 21.5), see the
  82 ;; following threads:
  83 ;;
  84 ;; http://thread.gmane.org/gmane.emacs.gnus.general/56414
  85 ;; Subject: attachment problems found but not fixed
  86 ;;
  87 ;; http://thread.gmane.org/gmane.emacs.gnus.general/56459
  88 ;; Subject: Splitting mail -- XEmacs 21.4 vs 21.5
  89 ;;
  90 ;; http://thread.gmane.org/gmane.emacs.xemacs.beta/20519
  91 ;; Subject: XEmacs 21.5 and Gnus fancy splitting.
  92 ;;
  93 ;; Should be fixed in XEmacs (March 2007).
  94 ;; http://thread.gmane.org/gmane.emacs.xemacs.patches/8124
  95 ;; When should we remove this workaround?
  96 ;;
  97 (when (and (featurep 'xemacs)
  98            (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
  99              (modify-syntax-entry ?= " " table)
 100              (with-temp-buffer
 101                (with-syntax-table table
 102                  (insert "foo=bar")
 103                  (goto-char (point-min))
 104                  (forward-sexp 1)
 105                  (eolp)))))
 106   ;; The original `with-syntax-table' uses `copy-syntax-table' which
 107   ;; doesn't seem to copy modified syntax entries in old XEmacs 21.5.
 108   (defmacro with-syntax-table (syntab &rest body)
 109     "Evaluate BODY with the SYNTAB as the current syntax table."
 110     `(let ((stab (syntax-table)))
 111        (unwind-protect
 112            (progn
 113              ;;(set-syntax-table (copy-syntax-table ,syntab))
 114              (set-syntax-table ,syntab)
 115              ,@body)
 116          (set-syntax-table stab)))))
 117
 118 (push srcdir load-path)
 119 (push loaddir load-path)
 120 (load (expand-file-name "lpath.el" loaddir) nil t)
 121
 122 (defalias 'device-sound-enabled-p 'ignore)
 123 (defalias 'play-sound-file 'ignore)
 124 (defalias 'efs-re-read-dir 'ignore)
 125 (defalias 'ange-ftp-re-read-dir 'ignore)
 126 (defalias 'define-mail-user-agent 'ignore)
 127 (defalias 'debbugs-gnu-summary-mode 'ignore)
 128 (defvar debbugs-gnu-bug-number nil)
 129
 130 (eval-and-compile
 131   (unless (featurep 'xemacs)
 132     (defalias 'get-popup-menu-response 'ignore)
 133     (defalias 'event-object 'ignore)
 134     (autoload 'iswitchb-read-buffer "iswitchb")
 135     (autoload 'netrc-credentials "netrc")
 136     (defalias 'x-defined-colors 'ignore)
 137     (defalias 'read-color 'ignore)))
 138
 139 (eval-and-compile
 140   (when (featurep 'xemacs)
 141     (defvar window-point-insertion-type nil)
 142     (unless (fboundp 'defadvice)
 143       (autoload 'defadvice "advice" nil nil 'macro))
 144     (unless (boundp 'help-echo-owns-message)
 145       (defvar help-echo-owns-message))
 146     (unless (boundp 'gnus-registry-enabled)
 147       (defvar gnus-registry-enabled nil))
 148     (unless (boundp 'mail-dont-reply-to-names)
 149       (defvar mail-dont-reply-to-names nil))
 150     (unless (fboundp 'url-retrieve-synchronously)
 151       (defalias 'url-retrieve-synchronously 'url-retrieve))
 152     (unless (fboundp 'url-queue-retrieve)
 153       (defun url-queue-retrieve (url callback &optional cbargs silent
 154                                      inhibit-cookies)
 155         (url-retrieve url callback cbargs)))
 156     (unless (boundp 'w3-configuration-directory)
 157       (setq w3-configuration-directory "~/.w3/"))
 158     (autoload 'Info-directory "info" nil t)
 159     (autoload 'Info-index "info" nil t)
 160     (autoload 'Info-index-next "info" nil t)
 161     (autoload 'Info-menu "info" nil t)
 162     (autoload 'ad-add-advice "advice")
 163     (unless (and (emacs-version>= 21 5)
 164                  (not (featurep 'sxemacs)))
 165       ;; calendar/auto-autoloads.el provides it.
 166       (autoload 'add-to-invisibility-spec "dummy"))
 167     (autoload 'annotations-at "annotations")
 168     (autoload 'apropos "apropos" nil t)
 169     (autoload 'apropos-command "apropos" nil t)
 170     (autoload 'bbdb-complete-name "bbdb-com" nil t)
 171     (autoload 'browse-url "browse-url" nil t)
 172     (autoload 'browse-url-of-file "browse-url" nil t)
 173     (autoload 'c-mode "cc-mode" nil t)
 174     (autoload 'customize-apropos "cus-edit" nil t)
 175     (autoload 'customize-group "cus-edit" nil t)
 176     (autoload 'customize-save-variable "cus-edit" nil t)
 177     (autoload 'customize-set-variable "cus-edit" nil t)
 178     (autoload 'customize-variable "cus-edit" nil t)
 179     (autoload 'debug "debug" nil t)
 180     (autoload 'sha1 "sha1")
 181     (if (featurep 'mule)
 182         (unless (locate-library "mule-ccl")
 183           (autoload 'define-ccl-program "ccl" nil nil 'macro))
 184       (defalias 'define-ccl-program 'ignore))
 185     (autoload 'delete-annotation "annotations")
 186     (autoload 'dolist "cl-macs" nil nil 'macro)
 187     (autoload 'enriched-decode "enriched")
 188     (autoload 'eudc-expand-inline "eudc" nil t)
 189     (autoload 'executable-find "executable")
 190     (autoload 'font-lock-fontify-buffer "font-lock" nil t)
 191     (when (and (emacs-version>= 21 5)
 192                (not (featurep 'sxemacs)))
 193       (autoload 'get-display-table "disp-table")
 194       (autoload 'put-display-table "disp-table"))
 195     (autoload 'info "info" nil t)
 196     (autoload 'mail-extract-address-components "mail-extr")
 197     (autoload 'mail-fetch-field "mail-utils")
 198     (autoload 'make-annotation "annotations")
 199     (autoload 'make-display-table "disp-table")
 200     (autoload 'pp "pp")
 201     (autoload 'ps-despool "ps-print" nil t)
 202     (autoload 'ps-spool-buffer "ps-print" nil t)
 203     (autoload 'ps-spool-buffer-with-faces "ps-print" nil t)
 204     (autoload 'read-passwd "passwd")
 205     (autoload 'regexp-opt "regexp-opt")
 206     (autoload 'reporter-submit-bug-report "reporter")
 207     (if (condition-case nil
 208             (progn
 209               (require 'rot13)
 210               (not (fboundp 'rot13-string)))
 211           (error nil))
 212         (defmacro rot13-string (string)
 213           "Return ROT13 encryption of STRING."
 214           `(let ((string ,string))
 215              (with-temp-buffer
 216                (insert string)
 217                (translate-region (point-min) (point-max) ,rot13-display-table)
 218                (buffer-string)))))
 219     (if (and (emacs-version>= 21 5)
 220              (not (featurep 'sxemacs)))
 221         (autoload 'setenv "process" nil t)
 222       (autoload 'setenv "env" nil t))
 223     (autoload 'sgml-mode "psgml" nil t)
 224     (autoload 'smtpmail-send-it "smtpmail")
 225     (autoload 'sort-numeric-fields "sort" nil t)
 226     (autoload 'sort-subr "sort")
 227     (autoload 'thing-at-point "thingatpt")
 228     (autoload 'toggle-truncate-lines "view-less" nil t)
 229     (autoload 'trace-function-background "trace" nil t)
 230     (autoload 'unmorse-region "morse" nil t)
 231     (defalias 'frame-char-height 'frame-height)
 232     (defalias 'frame-char-width 'frame-width)
 233     (defalias 'frame-parameter 'frame-property)
 234     (defalias 'make-overlay 'ignore)
 235     (defalias 'overlay-end 'ignore)