cgit.sxemacs.org Git - emchat/blob - emchat-utils.el

   1 ;; emchat-utils.el --- misc utils for EMchat   -*- Emacs-Lisp -*-
   2
   3 ;; Copyright (C) 2007 Steve Youngs
   4
   5 ;; Author:     Steve Youngs <steve@emchat.org>
   6 ;; Maintainer: Steve Youngs <steve@emchat.org>
   7 ;; Created:    <2007-09-01>
   8 ;; Homepage:   http://www.emchat.org/
   9 ;; Keywords:   utils ICQ emchat
  10
  11 ;; This file is part of EMchat.
  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 ;;    This is where any general-purpose utils for EMchat go
  43
  44 ;;; Code:
  45 (eval-when-compile
  46   (defvar emchat-all-aliases))
  47
  48 (defcustom emchat-glyph-dir
  49   (file-name-as-directory (or (locate-data-directory "emchat") ""))
  50   "Directory where icons and logos live."
  51   :type 'directory
  52   :group 'emchat-interface)
  53
  54 ;;; Internal variables
  55
  56 (defmacro emchat-do-in-xemacs (&rest body)
  57   "Execute BODY if in XEmacs."
  58   (when (featurep '(and xemacs (not sxemacs)))
  59     `(progn ,@body)))
  60
  61 (put 'emchat-do-in-xemacs 'lisp-indent-hook 'defun)
  62
  63 (defmacro emchat-do-in-sxemacs (&rest body)
  64   "Execute BODY if in SXEmacs."
  65   (when (featurep 'sxemacs)
  66     `(progn ,@body)))
  67
  68 (put 'emchat-do-in-sxemacs 'lisp-indent-hook 'defun)
  69
  70 (defun emchat-completing-read
  71   (prompt table &optional predicate require-match initial-contents history)
  72   "Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-CONTENTS, HISTORY.
  73 Same as `completing-read' but accepts strings as well as obarray."
  74   (completing-read
  75    prompt
  76    (if (vectorp table)
  77        table (mapcar 'list table))
  78    predicate require-match initial-contents history))
  79
  80 (defun emchat-numeric-uin (uin)
  81   "Return UIN as number.
  82 UIN can be either a string or number."
  83   (cond ((numberp uin) uin)
  84         ((stringp uin) (string-to-number uin))
  85         (t (error "Invalid UIN type" uin))))
  86
  87 (defun emchat-stringular-uin (uin)
  88   "Return UIN as a string.
  89 UIN can be either a string or a number."
  90   (cond ((numberp uin) (number-to-string uin))
  91         ((stringp uin) uin)
  92         (t (error "Invalid UIN type" uin))))
  93
  94 (defun emchat-valid-uin-p (uin)
  95   "Return non-nil if UIN is a valid uin."
  96   (not (zerop (emchat-numeric-uin uin))))
  97
  98 (defun emchat-completing-aliases (prompt &optional single)
  99   "Completing-read aliases/uin.
 100 PROMPT is the prompt for reading.
 101 SINGLE means read only one alias/uin.
 102
 103 Must at least complete one alias, use RET (empty string) to finish
 104 entering. It first completing-reads from the union of `emchat-active-aliases'
 105 and `emchat-connected-aliases'. If you hit RET and the input string is not in
 106 the union it the completing-reads from `emchat-all-aliases'.
 107
 108 Tips: You can also enter an uin in place of an alias."
 109   (let ((aliases
 110          ;; a must for first one
 111          (cons (emchat-completing-alias prompt 'required)
 112                (unless single
 113                  (loop collect (emchat-completing-alias prompt nil)
 114                        into aliases
 115                        ;; empty string means abort
 116                        until (string= (car (last aliases)) "")
 117                        finally return (nbutlast aliases))))))
 118     (delete-duplicates aliases :test 'string=)))
 119
 120 (defun emchat-completing-alias (prompt required)
 121   "Completing only one alias/uin.
 122 PROMPT is the prompt for reading.
 123 REQUIRED means cannot abort.
 124 Used by `emchat-completing-aliases'.
 125 No abortion when `** ' is in prompt.
 126 Abort by RET (empty string) when `++ ' is in prompt."
 127   (let ((all emchat-all-aliases)
 128         (alias
 129           (emchat-completing-read
 130            prompt
 131            emchat-all-aliases
 132            nil nil nil 'emchat-alias-history)))
 133     (unless (or
 134              ;; valid alias
 135              (member alias all)
 136              ;; valid uin
 137              (emchat-valid-uin-p alias)
 138              ;; abort
 139              (and (string= alias "")
 140                   (not required)))
 141       (loop do
 142         (setq alias
 143               (emchat-completing-read
 144                (concat (if required "** " "++ ") prompt)
 145                all nil t alias 'emchat-alias-history))
 146         while (and (string= alias "") required)))
 147     alias))
 148
 149 (defun emchat-switch-buffer (buffer)
 150   (when buffer
 151     (select-window (get-buffer-window buffer))))
 152
 153
 154
 155 (provide 'emchat-utils)
 156 ;;; emchat-utils.el ends here