cgit.sxemacs.org Git - sxemacs/blob - lisp/emod-utils.el

   1 ;; emod-utils.el --- Lisp utils for emodules   -*- Emacs-Lisp -*-
   2
   3 ;; Copyright (C) 2008 Steve Youngs
   4
   5 ;; Author:     Steve Youngs <steve@sxemacs.org>
   6 ;; Maintainer: SXEmacs Development Team <sxemacs-devel@sxemacs.org>
   7 ;; Created:    <2008-05-01>
   8 ;; Homepage:   http://www.sxemacs.org/
   9 ;; Keywords:   util, module, emodule, dumped
  10
  11 ;; This file is part of SXEmacs.
  12
  13 ;; Redistribution and use in source and binary forms, with or without
  14 ;; modification, are permitted provided that the following conditions
  15 ;; are met:
  16 ;;
  17 ;; 1. Redistributions of source code must retain the above copyright
  18 ;;    notice, this list of conditions and the following disclaimer.
  19 ;;
  20 ;; 2. Redistributions in binary form must reproduce the above copyright
  21 ;;    notice, this list of conditions and the following disclaimer in the
  22 ;;    documentation and/or other materials provided with the distribution.
  23 ;;
  24 ;; 3. Neither the name of the author nor the names of any contributors
  25 ;;    may be used to endorse or promote products derived from this
  26 ;;    software without specific prior written permission.
  27 ;;
  28 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  29 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  30 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  31 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  32 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  33 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  34 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  35 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  36 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  37 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  38 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  39
  40 ;;; Commentary:
  41 ;;
  42 ;;    Here are a number of utils for interacting with emodules, such
  43 ;;    as finding them, loading them.  That sort of thing.
  44 ;;
  45 ;;    This file is dumped with SXEmacs.
  46
  47 ;;; Todo:
  48 ;;
  49 ;;
  50
  51 ;;; Code:
  52 (defvar emodule-completions nil
  53   "List of emodules for use in completion with `load-module'.")
  54
  55 (defvar load-module-history nil
  56   "History for `load-module'.")
  57
  58 (defun emodule-completions (&optional path)
  59   "Return a list of emodules.
  60
  61 It searches through `module-load-path' by default, or PATH if that
  62 optional argument is set.
  63
  64 PATH can be either a list of path strings, or it can be a colon
  65 delimited path string."
  66   (let ((dirs (or (if (stringp path)
  67                       (split-string-by-char path ?:)
  68                     path)
  69                   module-load-path))
  70         (types (concat "\\.\\("
  71                        (mapconcat
  72                         #'(lambda (e)
  73                             (replace-in-string e "\\." ""))
  74                         module-extensions "\\|")
  75                        "\\)$"))
  76                ;; http://issues.sxemacs.org/show_bug.cgi?id=162
  77                ;; (mapfam
  78                ;;  #'(lambda (e)
  79                ;;      (replace-in-string e "\\." ""))
  80                ;;  :initiator "\\.\\("
  81                ;;  :terminator "\\)$"
  82                ;;  :separator "\\|"
  83                ;;  :result-type #'concat module-extensions))
  84         completions)
  85     (while dirs
  86       (let ((files (directory-files-recur (car dirs) nil types 'list t 0)))
  87         (when (and files (> (length files) 0))
  88           (setq completions
  89                 (append completions
  90                         (mapfam
  91                          #'file-name-sans-extension files
  92                          :result-type #'list))))
  93         (setq dirs (cdr dirs))))
  94     (remove-duplicates (remove nil completions) :test #'string-equal)))
  95
  96 (defun locate-module (emod)
  97   "Similar to `locate-library', but for emodules."
  98   (interactive
  99    (list (completing-read "Locate Emodule: "
 100                           (mapfam #'list (or emodule-completions
 101                                              (emodule-completions)))
 102                           nil nil nil load-module-history)))
 103   (unless emodule-completions
 104     (setq emodule-completions (emodule-completions)))
 105   (let* ((emod (file-name-sans-extension emod))
 106          (location (locate-file emod module-load-path
 107                                 module-extensions)))
 108     (if (interactive-p)
 109         (message "%s is: %s" emod location)
 110       location)))
 111
 112 (defun load-module (emod)
 113   "Similar to `load-library', but for emodules."
 114   (interactive
 115    (list (completing-read "Load emodule: "
 116                           (mapfam #'list (or emodule-completions
 117                                              (emodule-completions)))
 118                           nil nil nil load-module-history)))
 119   (unless emodule-completions
 120     (setq emodule-completions (emodule-completions)))
 121   (if (string-equal emod "")
 122       (error 'invalid-argument emod)
 123     (and-fboundp #'load-module-file
 124       (load-module-file
 125        (or (locate-module emod)
 126            emod)))))
 127
 128 (defun list-modules ()
 129   "Return a list of loaded emodules, display in echo area when interactive."
 130   (interactive)
 131   (and-fboundp #'list-loaded-modules
 132     (let ((emods (list-loaded-modules)))
 133       (if (interactive-p)
 134           (message "Loaded emodules: %s"
 135                    (mapconcat #'identity emods " "))
 136                    ;; http://issues.sxemacs.org/show_bug.cgi?id=162
 137                    ;; (mapfam nil emods :separator " " :result-type #'concat))
 138         emods))))
 139
 140 (provide 'emod-utils)
 141 ;;; emod-utils.el ends here