emacs/guix-utils.el

   1 ;;; guix-utils.el --- General utility functions  -*- lexical-binding: t -*-
   2
   3 ;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
   4
   5 ;; This file is part of GNU Guix.
   6
   7 ;; GNU Guix is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Guix is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;; This file provides auxiliary general functions for guix.el package.
  23
  24 ;;; Code:
  25
  26 (require 'cl-lib)
  27
  28 (defvar guix-true-string "Yes")
  29 (defvar guix-false-string "–")
  30 (defvar guix-list-separator ", ")
  31
  32 (defvar guix-time-format "%F %T"
  33   "String used to format time values.
  34 For possible formats, see `format-time-string'.")
  35
  36 (defun guix-get-string (val &optional face)
  37   "Convert VAL into a string and return it.
  38
  39 VAL can be an expression of any type.
  40 If VAL is t/nil, it is replaced with
  41 `guix-true-string'/`guix-false-string'.
  42 If VAL is list, its elements are concatenated using
  43 `guix-list-separator'.
  44
  45 If FACE is non-nil, propertize returned string with this FACE."
  46   (let ((str (cond
  47               ((stringp val) val)
  48               ((null val) guix-false-string)
  49               ((eq t val) guix-true-string)
  50               ((numberp val) (number-to-string val))
  51               ((listp val) (mapconcat #'guix-get-string
  52                                       val guix-list-separator))
  53               (t (prin1-to-string val)))))
  54     (if (and val face)
  55         (propertize str 'font-lock-face face)
  56       str)))
  57
  58 (defun guix-get-time-string (seconds)
  59   "Return formatted time string from SECONDS.
  60 Use `guix-time-format'."
  61   (format-time-string guix-time-format (seconds-to-time seconds)))
  62
  63 (defun guix-get-one-line (str)
  64   "Return one-line string from a multi-line STR."
  65   (replace-regexp-in-string "\n" " " str))
  66
  67 (defun guix-format-insert (val &optional face format)
  68   "Convert VAL into a string and insert it at point.
  69 If FACE is non-nil, propertize VAL with FACE.
  70 If FORMAT is non-nil, format VAL with FORMAT."
  71   (let ((str (guix-get-string val face)))
  72     (insert (if format
  73                 (format format str)
  74               str))))
  75
  76 (defun guix-mapinsert (function sequence separator)
  77   "Like `mapconcat' but for inserting text.
  78 Apply FUNCTION to each element of SEQUENCE, and insert SEPARATOR
  79 at point between each FUNCTION call."
  80   (when sequence
  81     (funcall function (car sequence))
  82     (mapc (lambda (obj)
  83             (insert separator)
  84             (funcall function obj))
  85           (cdr sequence))))
  86
  87 (defun guix-insert-button (label &optional type &rest properties)
  88   "Make button of TYPE with LABEL and insert it at point.
  89 See `insert-text-button' for the meaning of PROPERTIES."
  90   (if (null label)
  91       (guix-format-insert nil)
  92     (apply #'insert-text-button label
  93            :type (or type 'button)
  94            properties)))
  95
  96 (defun guix-split-insert (val &optional face col separator)
  97   "Convert VAL into a string, split it and insert at point.
  98
  99 If FACE is non-nil, propertize returned string with this FACE.
 100
 101 If COL is non-nil and result string is a one-line string longer
 102 than COL, split it into several short lines.
 103
 104 Separate inserted lines with SEPARATOR."
 105   (if (null val)
 106       (guix-format-insert nil)
 107     (let ((strings (guix-split-string (guix-get-string val) col)))
 108       (guix-mapinsert (lambda (str) (guix-format-insert str face))
 109                       strings
 110                       (or separator "")))))
 111
 112 (defun guix-split-string (str &optional col)
 113   "Split string STR by lines and return list of result strings.
 114 If COL is non-nil and STR is a one-line string longer than COL,
 115 split it into several short lines."
 116   (let ((strings (split-string str "\n *")))
 117     (if (and col
 118              (null (cdr strings))       ; if not multi-line
 119              (> (length str) col))
 120         (split-string (guix-get-filled-string str col) "\n")
 121       strings)))
 122
 123 (defun guix-get-filled-string (str col)
 124   "Return string by filling STR to column COL."
 125   (with-temp-buffer
 126     (insert str)
 127     (let ((fill-column col))
 128       (fill-region (point-min) (point-max)))
 129     (buffer-string)))
 130
 131 (defun guix-completing-read-multiple (prompt table &optional predicate
 132                                       require-match initial-input
 133                                       hist def inherit-input-method)
 134   "Same as `completing-read-multiple' but remove duplicates in result."
 135   (cl-remove-duplicates
 136    (completing-read-multiple prompt table predicate
 137                              require-match initial-input
 138                              hist def inherit-input-method)
 139    :test #'string=))
 140
 141 (declare-function org-read-date "org" t)
 142
 143 (defun guix-read-date (prompt)
 144   "Prompt for a date or time using `org-read-date'.
 145 Return time value."
 146   (require 'org)
 147   (org-read-date nil t nil prompt))
 148
 149 (defun guix-get-key-val (alist &rest keys)
 150   "Return value from ALIST by KEYS.
 151 ALIST is alist of alists of alists ... which can be consecutively
 152 accessed with KEYS."
 153   (let ((val alist))
 154     (dolist (key keys val)
 155       (setq val (cdr (assq key val))))))
 156
 157 (defun guix-find-file (file)
 158   "Find FILE if it exists."
 159   (if (file-exists-p file)
 160       (find-file file)
 161     (message "File '%s' does not exist." file)))
 162
 163 \f
 164 ;;; Diff
 165
 166 (defvar guix-diff-switches "-u"
 167   "A string or list of strings specifying switches to be passed to diff.")
 168
 169 (defun guix-diff (old new &optional switches no-async)
 170   "Same as `diff', but use `guix-diff-switches' as default."
 171   (diff old new (or switches guix-diff-switches) no-async))
 172
 173 \f
 174 ;;; Memoizing
 175
 176 (defun guix-memoize (function)
 177   "Return a memoized version of FUNCTION."
 178   (let ((cache (make-hash-table :test 'equal)))
 179     (lambda (&rest args)
 180       (let ((result (gethash args cache 'not-found)))
 181         (if (eq result 'not-found)
 182             (let ((result (apply function args)))
 183               (puthash args result cache)
 184               result)
 185           result)))))
 186
 187 (defmacro guix-memoized-defun (name arglist docstring &rest body)
 188   "Define a memoized function NAME.
 189 See `defun' for the meaning of arguments."
 190   (declare (doc-string 3) (indent 2))
 191   `(defalias ',name
 192      (guix-memoize (lambda ,arglist ,@body))
 193      ;; Add '(name args ...)' string with real arglist to the docstring,
 194      ;; because *Help* will display '(name &rest ARGS)' for a defined
 195      ;; function (since `guix-memoize' returns a lambda with '(&rest
 196      ;; args)').
 197      ,(format "(%S %s)\n\n%s"
 198               name
 199               (mapconcat #'symbol-name arglist " ")
 200               docstring)))
 201
 202 (provide 'guix-utils)
 203
 204 ;;; guix-utils.el ends here