;;; std/util.el --- standard utils  -*- lexical-binding: t -*-

 ;;; Code:

 (require 'cl-lib)

 (require 'calendar)

 ;;; Helpers

 (defun group (source n)

   "This is Paul Graham's group utility from On Lisp.

 Group a list of arguments SOURCE by any provided grouping amount

 N.

 For example:

 (group (quote (foo 2 bar 4)) 2) ;=> ((foo 2) (bar 4))

 (group (quote (a b c d e f)) 3) ;=> ((a b c) (d e f))

 "

   (when (zerop n) (error "zero length"))

   (cl-labels ((rec (source acc)

                    (let ((rest (nthcdr n source)))

                      (if (consp rest)

                          (rec rest (cons

                                     (cl-subseq source 0 n)

                                     acc))

                        (nreverse

                         (cons source acc))))))

     (when source (rec source nil))))

 (defun flatten (x)

   "Paul Graham's flatten utility from On Lisp.

 Given a tree X, return all the leaves of the tree."

   (cl-labels ((rec (x acc)

                    (cond ((null x) acc)

                          ((atom x) (cons x acc))

                          (t (rec

                              (car x)

                              (rec (cdr x) acc))))))

     (rec x nil)))

 (defun mkstr (&rest args)

   "Paul Graham's mkstr utility from On Lisp.

 Coerce ARGS into a single string and return it."

   (let* ((s ""))

     (dolist (a args)

       (cond

        ((null a) nil)

        ((sequencep a) (setq s (concat s a)))

        ((numberp a) (setq s(concat s (number-to-string a))))

        ((symbolp a) (setq s(concat s (symbol-name a))))))

     s))

 (defun symb (&rest args)

   "Paul Graham's symb utility from On Lisp.

 Concat ARGS and return a newly interned symbol."

   (intern (apply #'mkstr args)))

 ;;; Config

 (defun add-to-load-path (&rest paths)

   "Add PATHS to `load-path'."

   (mapc (lambda (x)

           (cond

            ((listp x) (mapc #'add-to-load-path x))

            ('_ (cl-pushnew x load-path))))

         paths))

 (defmacro add-packages (&rest pkgs)

   "add list of packages PKGS to `package-selected-packages'"

   `(mapc (lambda (x) (add-to-list 'package-selected-packages x)) ',pkgs))

 (defun load-keys (&optional custom)

   (let ((keydefs (or custom (concat user-emacs-directory "keys.el"))))

     (load keydefs nil t)))

 ;;; OS

 (defmacro when-sys= (name body)

   "(when (string= (system-name) NAME) BODY)"

   `(when ,(string= (system-name) name) ,body))

 (defun darwin-p () (string= system-type "darwin"))

 (defun linux-p () (string= system-type "gnu/linux"))

 (defun join-paths (root &rest dirs)

   "helper function for joining strings to a path."

   (let ((result root))

     (cl-loop for dir in dirs do

              (setq result (concat (file-name-as-directory result) dir)))

     result))

 (defun wc ()

   "Return a 3-element list with lines, words and characters in

 region or whole buffer."

   (interactive)

   (let ((n 0)

         (start (if mark-active (region-beginning) (point-min)))

         (end (if mark-active (region-end) (point-max))))

     (save-excursion

       (goto-char start)

       (while (< (point) end) (if (forward-word 1) (setq n (1+ n)))))

     (list (count-lines start end) n (- end start))))

 ;;; Regexps

 (defvar default-line-regexp-alist

   '((empty . "[\s\t]*$")

     (indent . "^[\s\t]+")

     (non-empty . "^.+$")

     (list . "^\\([\s\t#*+]+\\|[0-9]+[^\s]?[).]+\\)")

     (heading . "^[=-]+"))

   "Alist of regexp types used by `default-line-regexp-p'.")

 (defun default-line-regexp-p (type &optional n)

   "Test for TYPE on line.

 TYPE is the car of a cons cell in

 `default-line-regexp-alist'.  It matches a regular

 expression.

 With optional N, search in the Nth line from point."

   (save-excursion

     (goto-char (pos-bol))

     (and (not (bobp))

          (or (beginning-of-line n) t)

          (save-match-data

            (looking-at

             (alist-get type default-line-regexp-alist))))))

 ;;; Time

 (defun format-iso-week-number (&optional date)

   "format DATE as ISO week number with week days starting on

     Monday. If DATE is nil use current date."

   (let* ((week (format-time-string "%W" date))

          (prefix (if (= (length week) 1)

                      "w0" "w")))

     (concat prefix week)))

 (defun last-day-of-year (&optional date)

   "Return the last day of the year as time."

   (encode-time 0 0 0 31 12 (nth 5 (decode-time

                                    (or date (current-time))))))

 (defun last-day-of-month (&optional date)

   "Return the last day of month as time."

   (let* ((now (decode-time (or date (current-time))))

          (month (nth 4 now))

          (year (nth 5 now))

          (last-day-of-month (calendar-last-day-of-month month year)))

     (encode-time 0 0 0 last-day-of-month month year)))

 (defun last-day-of-week (&optional date)

   "Return the last day of the week as time."

   (let* ((now (or date (current-time)))

          (datetime (decode-time now))

          (dow (nth 6 datetime)))

     (time-add now (days-to-time (- 7 dow)))))

 (defun first-day-of-week (&optional date)

   "Return the first day of the week as time."

   (let* ((now (or date (current-time)))

          (datetime (decode-time now))

          (dow (nth 6 datetime)))

     (time-subtract now (days-to-time dow))))

 ;;; Hashtables

 (defun hash-table-alist (table)

   "Returns an association list containing the keys and values of hash table

 TABLE."

   (let ((alist nil))

     (maphash (lambda (k v)

                (push (cons k v) alist))

              table)

     (nreverse alist)))

 ;;; Server

 ;;;###autoload

 (defun kill-emacs-restart ()

   (interactive)

   (server-force-delete)

   (server-start))

 (define-key special-event-map [sigusr1] 'kill-emacs-restart)

 (defun upgrade-emacs (&optional ask)

   (interactive)

   (package-refresh-contents)

   (package-install-selected-packages (not ask))

   (package-upgrade-all ask))

 (provide 'util)

 ;; util.el ends here