Last edit
Sammanfattning: updated version
Ändrad:
< ;; Version: 0.2.2
< ;; Last-Updated: 30 Oct 2012
till
> ;; Version: 0.2.6
> ;; Last-Updated: 6 Nov 2012
Ändrad:
< ;; (truthy 1) ; t
< ;; (truthy '(a b c)) ; t
till
> ;; (truthy 1) ; 1
> ;; (truthy '(a b c)) ; '(a b c)
Tillagd:
> ;; (truthy '([] "" 0)) ; nil
> ;;
> ;; (truthy-s '([] "" 0)) ; '([] "" 0) ; shallow test
> ;;
> ;; (truthy-l '(nil nil nil)) ; '(nil nil nil) ; lengthwise test
Ändrad:
< ;; for programming in Emacs Lisp. Two functions are provided:
till
> ;; for programming in Emacs Lisp. Three functions are provided:
Tillagd:
> ;; `truthy-l'
Ändrad:
< ;; "true" if it has *content*. If the value is a string or buffer, it
< ;; must have non-zero length. If a number, it must be non-zero. If a
< ;; hash, it must have keys. If a window, it must be live. See the
< ;; docstring to `truthy' for more details.
till
> ;; "truthy" if it has *content*. If the value is a string or buffer,
> ;; it must have non-zero length. If a number, it must be non-zero.
> ;; If a hash, it must have keys. If a window, it must be live. See
> ;; the docstring to `truthy' for more details.
> ;;
> ;; `truthy' always returns its argument on success.
> ;;
> ;; `truthy-s' is the shallow version of `truthy'. It does not recurse
> ;; into sequences, but returns success if any element of a sequence is
> ;; non-nil.
> ;;
> ;; `truthy-l' is the "lengthwise" version of `truthy'. It does not
> ;; recurse into sequences, but returns success if the argument has
> ;; length, considering only the variable portion of a data type.
Ändrad:
< ;; TODO
till
> ;; truthy-l is fairly meaningless on structs
Ändrad:
< ;; obarray per string-utils
< ;;
< ;; Tests for truthy-s.
till
> ;; TODO
Ändrad:
< (defun truthy (obj &optional shallow)
till
> (defun truthy (obj &optional shallow length)
Ändrad:
< \"true\" if it has *content*.
till
> \"truthy\" if it has *content*.
> When OBJ has \"truthiness\", `truthy' returns OBJ, otherwise
> nil.
Ändrad:
< returns non-nil, because the list holds non-nil elements.
till
> returns OBJ, because the list holds non-nil elements.
Ändrad:
< \(truthy OBJ 'shallow\)."
till
> \(truthy OBJ 'shallow\).
> When optional LENGTH is non-nil, OBJ is always truthy if the
> concept of length can be applied to it and OBJ has non-zero
> length, considering only the portion of the data type which may
> vary in length. If the concept of length cannot be applied to
> OBJ, the usual rules apply. So
> (truthy '(nil nil) nil 'length)
> has length and returns OBJ. And eg
> (truthy (lambda (args)))
> has no length (because the lambda has no body) and returns nil.
> For a ring or object, the \"lengthwise\" test can check whether
> any slots have been filled. For a struct it is not possible to
> distinguish between unfilled slots and slots filled with nil, so
> the lengthwise test succeeds if there is a non-zero number of
> slots.
> The function `truthy-l' is provided as shorthand for
> \(truthy OBJ nil 'length\)."
Tillagd:
> ;; symbol
> ((symbolp obj)
> obj)
Ändrad:
< (when (or (and shallow elt)
till
> (when (or length
> (and shallow elt)
Ändrad:
< (throw 'truthy t)))
till
> (throw 'truthy obj)))
Ändrad:
< (aref obj 1))
till
> (when (aref obj 1)
> obj))
Ändrad:
< (when (or (and shallow elt)
till
> (when (or length
> (and shallow elt)
Ändrad:
< (throw 'truthy t)))
till
> (throw 'truthy obj)))
Ändrad:
< (when (or (and shallow elt)
till
> (when (or length
> (and shallow elt)
Ändrad:
< (throw 'truthy t)))
till
> (throw 'truthy obj)))
Ändrad:
< (when (or (and shallow elt)
till
> (when (or length
> (and shallow elt)
Ändrad:
< (throw 'truthy t)))
till
> (throw 'truthy obj)))
Ändrad:
< (when (or (and shallow elt)
till
> (when (or length
> (and shallow elt)
Ändrad:
< (throw 'truthy t)))
till
> (throw 'truthy obj)))
Ändrad:
< (not (equal obj (make-sparse-keymap))))
till
> (catch 'truthy
> (dolist (elt (cdr obj))
> (when (or length
> (and shallow elt)
> (truthy elt))
> (throw 'truthy obj)))
> nil))
Ändrad:
< (/= 0 obj))
till
> (when (/= 0 obj)
> obj))
Ändrad:
< (and (buffer-live-p obj)
< (> (with-current-buffer obj (point-max)) 1)))
till
> (when (and (buffer-live-p obj)
> (> (with-current-buffer obj (point-max)) 1))
> obj))
Ändrad:
< (frame-live-p obj))
till
> (when (frame-live-p obj)
> obj))
Ändrad:
< (window-live-p obj))
till
> (when (window-live-p obj)
> obj))
Ändrad:
< (and (marker-buffer obj)
< (marker-position obj)))
till
> (when (and (marker-buffer obj)
> (marker-position obj))
> obj))
Ändrad:
< (and (overlay-buffer obj)
< (overlay-start obj)
< (overlay-end obj)))
till
> (when (and (overlay-buffer obj)
> (overlay-start obj)
> (overlay-end obj)
> (or (not length)
> (/= (overlay-start obj)
> (overlay-end obj))))
> obj))
Ändrad:
< (process-live-p obj))
till
> (when (process-live-p obj)
> obj))
Ändrad:
< (when (or (and shallow elt)
till
> (when (or length
> (and shallow elt)
Ändrad:
< (throw 'truthy t)))
till
> (throw 'truthy obj)))
Ändrad:
< (throw 'truthy t)))
till
> (throw 'truthy obj)))
Ändrad:
< (throw 'truthy t))) obj)
till
> (throw 'truthy obj))) obj)
Ändrad:
< (throw 'truthy t))
till
> (throw 'truthy obj))
Ändrad:
< (throw 'truthy t))
till
> (throw 'truthy obj))
Ändrad:
< (> (length obj) 0))
till
> (when (> (length obj) 0)
> obj))
Ändrad:
< ;; cons or improper list would choke mapcar
< (and (truthy (subseq obj 0 len))
< (truthy (nthcdr len obj))))
till
> ;; cons or improper list would choke dolist
> (when (or length
> shallow ; already known to have a non-nil element
> (or (truthy (subseq obj 0 len))
> (truthy (nthcdr len obj))))
> obj))
Ändrad:
< (when (or (and shallow elt)
till
> (when (or length
> (and shallow elt)
Ändrad:
< (throw 'truthy t)))
till
> (throw 'truthy obj)))
Ändrad:
< (when (or (and shallow elt)
till
> (when (or length
> (and shallow elt)
Ändrad:
< (throw 'truthy t)))
till
> (throw 'truthy obj)))
Ändrad:
< This is equivalent to calling `truthy' with the SHALLOW parameter
< set."
till
> This is equivalent to calling `truthy' with the SHALLOW argument
> non-nil."
Tillagd:
> ;;;###autoload
> (defun truthy-l (obj)
> "Return non-nil if OBJ has lengthwise \"truthiness\".
> This is equivalent to calling `truthy' with the LENGTH argument
> non-nil."
> (truthy obj nil 'length))
Ändrad:
< ;; LocalWords: defstruct subseq utils eieio subr
till
> ;; LocalWords: defstruct subseq utils eieio subr structs struct
;;; truthy.el --- Test the content of a value ;; ;; Copyright (c) 2012 Roland Walker ;; ;; Author: Roland Walker <walker@pobox.com> ;; Homepage: http://github.com/rolandwalker/truthy ;; URL: http://raw.github.com/rolandwalker/truthy/master/truthy.el ;; Version: 0.2.6 ;; Last-Updated: 6 Nov 2012 ;; Package-Requires: ((list-utils "0.1.2")) ;; EmacsWiki: Truthy ;; Keywords: extensions ;; ;; Simplified BSD License ;; ;;; Commentary: ;; ;; Quickstart ;; ;; (require 'truthy) ;; ;; (truthy "") ; nil ;; (truthy '[]) ; nil ;; (truthy 0) ; nil ;; (truthy (lambda ())) ; nil ;; (truthy (make-sparse-keymap)) ; nil ;; (truthy 1) ; 1 ;; (truthy '(a b c)) ; '(a b c) ;; (truthy '(nil nil nil)) ; nil ;; (truthy '([] "" 0)) ; nil ;; ;; (truthy-s '([] "" 0)) ; '([] "" 0) ; shallow test ;; ;; (truthy-l '(nil nil nil)) ; '(nil nil nil) ; lengthwise test ;; ;; Explanation ;; ;; This library has no user-level interface; it is only useful ;; for programming in Emacs Lisp. Three functions are provided: ;; ;; `truthy' ;; `truthy-s' ;; `truthy-l' ;; ;; Truthy provides an alternative measure of the "truthiness" of a ;; value. Whereas Lisp considers any non-nil value to be "true" when ;; evaluating a Boolean condition, `truthy' considers a value to be ;; "truthy" if it has *content*. If the value is a string or buffer, ;; it must have non-zero length. If a number, it must be non-zero. ;; If a hash, it must have keys. If a window, it must be live. See ;; the docstring to `truthy' for more details. ;; ;; `truthy' always returns its argument on success. ;; ;; `truthy-s' is the shallow version of `truthy'. It does not recurse ;; into sequences, but returns success if any element of a sequence is ;; non-nil. ;; ;; `truthy-l' is the "lengthwise" version of `truthy'. It does not ;; recurse into sequences, but returns success if the argument has ;; length, considering only the variable portion of a data type. ;; ;; To use truthy, place the truthy.el library somewhere Emacs can find ;; it, and add the following to your ~/.emacs file: ;; ;; (require 'truthy) ;; ;; Notes ;; ;; Compatibility and Requirements ;; ;; GNU Emacs version 24.3-devel : yes ;; GNU Emacs version 24.1 & 24.2 : yes ;; GNU Emacs version 23.3 : yes ;; GNU Emacs version 22.3 and lower : no ;; ;; Uses if present: list-utils.el ;; ;; Bugs ;; ;; truthy-l is fairly meaningless on structs ;; ;; TODO ;; ;;; License ;; ;; Simplified BSD License: ;; ;; Redistribution and use in source and binary forms, with or ;; without modification, are permitted provided that the following ;; conditions are met: ;; ;; 1. Redistributions of source code must retain the above ;; copyright notice, this list of conditions and the following ;; disclaimer. ;; ;; 2. Redistributions in binary form must reproduce the above ;; copyright notice, this list of conditions and the following ;; disclaimer in the documentation and/or other materials ;; provided with the distribution. ;; ;; This software is provided by Roland Walker "AS IS" and any express ;; or implied warranties, including, but not limited to, the implied ;; warranties of merchantability and fitness for a particular ;; purpose are disclaimed. In no event shall Roland Walker or ;; contributors be liable for any direct, indirect, incidental, ;; special, exemplary, or consequential damages (including, but not ;; limited to, procurement of substitute goods or services; loss of ;; use, data, or profits; or business interruption) however caused ;; and on any theory of liability, whether in contract, strict ;; liability, or tort (including negligence or otherwise) arising in ;; any way out of the use of this software, even if advised of the ;; possibility of such damage. ;; ;; The views and conclusions contained in the software and ;; documentation are those of the authors and should not be ;; interpreted as representing official policies, either expressed ;; or implied, of Roland Walker. ;; ;;; Code: ;; ;;; requirements ;; for subseq (require 'cl) (require 'eieio nil t) (require 'list-utils nil t) ;;; declarations (declare-function object-p "eieio.el") (declare-function process-live-p "subr.el") (declare-function ring-elements "ring.el") (eval-when-compile (defvar eieio-unbound)) ;;; compatibility functions (unless (fboundp 'process-live-p) (defun process-live-p (process) "Returns non-nil if PROCESS is alive. A process is considered alive if its status is `run', `open', `listen', `connect' or `stop'." (memq (process-status process) '(run open listen connect stop)))) ;;; external interface ;;;###autoload (defun truthy (obj &optional shallow length) "Return non-nil if OBJ has \"truthiness\". Whereas Lisp considers any non-nil value to be \"true\" when evaluating a Boolean condition, `truthy' considers a value to be \"truthy\" if it has *content*. When OBJ has \"truthiness\", `truthy' returns OBJ, otherwise nil. If OBJ is a constant or symbol other than nil, it is always truthy. If OBJ is a number, it must be non-zero. If OBJ is a hash table, it must have keys. If OBJ is a function or a macro, it must have a body containing at least one truthy value. If OBJ is compiled byte-code, it must have a body. If OBJ is a keymap, it must have defined keys. If OBJ is a char-table, it must have keys as returned by `map-char-table'. If OBJ is a abbrev-table, it must have at least one value. If OBJ is a defstruct or EIEIO object, at least one slot must contain a truthy value. If OBJ is a ring, it must contain at least one truthy element. If OBJ is a string, it must have length greater than zero. If OBJ is a sequence, if must contain at least one truthy value. If OBJ is a marker or overlay, it must be associated with a buffer and have a position. If OBJ is a buffer, it must be live and of non-zero length. If OBJ is a frame, window, or process, it must be live, according to (eg) `window-live-p'. If OBJ is a font, at least one property of the font must be specified. When optional SHALLOW is non-nil, recursive considerations do not examine truthiness, simply whether constituent elements are non-nil. Therefore (truthy '(0 0 0 0)) returns nil, because no truthy element is found in the list. But (truthy '(0 0 0 0) 'shallow) returns OBJ, because the list holds non-nil elements. The function `truthy-s' is provided as shorthand for \(truthy OBJ 'shallow\). When optional LENGTH is non-nil, OBJ is always truthy if the concept of length can be applied to it and OBJ has non-zero length, considering only the portion of the data type which may vary in length. If the concept of length cannot be applied to OBJ, the usual rules apply. So (truthy '(nil nil) nil 'length) has length and returns OBJ. And eg (truthy (lambda (args))) has no length (because the lambda has no body) and returns nil. For a ring or object, the \"lengthwise\" test can check whether any slots have been filled. For a struct it is not possible to distinguish between unfilled slots and slots filled with nil, so the lengthwise test succeeds if there is a non-zero number of slots. The function `truthy-l' is provided as shorthand for \(truthy OBJ nil 'length\)." (cond ;; nil ((null obj) nil) ;; '[] ((and (vectorp obj) (= 0 (length obj))) nil) ;; symbol ((symbolp obj) obj) ;; defstruct ((and (vectorp obj) (symbolp (aref obj 0)) (string-match-p "\\`cl-" (symbol-name (aref obj 0)))) (catch 'truthy (dolist (elt (append (subseq obj 1 (length obj)) nil)) (when (or length (and shallow elt) (truthy elt)) (throw 'truthy obj))) nil)) ;; compiled byte-code ((byte-code-function-p obj) (when (aref obj 1) obj)) ;; ring ((ring-p obj) (catch 'truthy (dolist (elt (ring-elements obj)) (when (or length (and shallow elt) (truthy elt)) (throw 'truthy obj))) nil)) ;; macro ((and (listp obj) (eq 'macro (car obj)) (functionp (cdr obj))) (catch 'truthy (dolist (elt (cdddr obj)) (when (or length (and shallow elt) (truthy elt)) (throw 'truthy obj))) nil)) ;; function ((functionp obj) (catch 'truthy (dolist (elt (cddr obj)) (when (or length (and shallow elt) (truthy elt)) (throw 'truthy obj))) nil)) ;; frame-configuration ((frame-configuration-p obj) (catch 'truthy (dolist (elt (cdr obj)) (when (or length (and shallow elt) (truthy elt)) (throw 'truthy obj))) nil)) ;; keymap ((keymapp obj) (catch 'truthy (dolist (elt (cdr obj)) (when (or length (and shallow elt) (truthy elt)) (throw 'truthy obj))) nil)) ;; number ((numberp obj) (when (/= 0 obj) obj)) ;; buffer ((bufferp obj) (when (and (buffer-live-p obj) (> (with-current-buffer obj (point-max)) 1)) obj)) ;; frame ((framep obj) (when (frame-live-p obj) obj)) ;; window ((windowp obj) (when (window-live-p obj) obj)) ;; marker ((markerp obj) (when (and (marker-buffer obj) (marker-position obj)) obj)) ;; overlay ((overlayp obj) (when (and (overlay-buffer obj) (overlay-start obj) (overlay-end obj) (or (not length) (/= (overlay-start obj) (overlay-end obj)))) obj)) ;; process ((processp obj) (when (process-live-p obj) obj)) ;; EIEIO object ((and (fboundp 'object-p) (object-p obj)) (catch 'truthy (dolist (elt (remq eieio-unbound (append (subseq obj 3 (length obj)) nil))) (when (or length (and shallow elt) (truthy elt)) (throw 'truthy obj))) nil)) ;; font object ((fontp obj) (catch 'truthy (dolist (k '(:family :weight :slant :width :foundry :adstyle :registry :size :name :script :otf)) (when (font-get obj k) (throw 'truthy obj))) nil)) ;; abbrev-table ((ignore-errors (abbrev-table-p obj)) (catch 'truthy (mapatoms #'(lambda (sym) (when (> (length (symbol-name sym)) 0) (throw 'truthy obj))) obj) nil)) ;; hash-table ((hash-table-p obj) (catch 'truthy (maphash #'(lambda (k v) (throw 'truthy obj)) obj) nil)) ;; char-table ((char-table-p obj) (catch 'truthy (map-char-table #'(lambda (k v) (throw 'truthy obj)) obj) nil)) ;; string ((stringp obj) (when (> (length obj) 0) obj)) ;; list ((listp obj) (let* ((measurer (if (fboundp 'list-utils-safe-length) 'list-utils-safe-length 'safe-length)) (len (funcall measurer obj))) (cond ((and (consp obj) (> len 0) (not (listp (nthcdr len obj)))) ;; cons or improper list would choke dolist (when (or length shallow ; already known to have a non-nil element (or (truthy (subseq obj 0 len)) (truthy (nthcdr len obj)))) obj)) (t (catch 'truthy ;; subseq is to break circular lists (dolist (elt (subseq obj 0 (funcall measurer obj))) (when (or length (and shallow elt) (truthy elt)) (throw 'truthy obj))) nil))))) ;; non-list sequence ((sequencep obj) (catch 'truthy (dolist (elt (mapcar 'identity (append obj nil))) (when (or length (and shallow elt) (truthy elt)) (throw 'truthy obj))) nil)) ;; fallback (t obj))) ;;;###autoload (defun truthy-s (obj) "Return non-nil if OBJ has shallow \"truthiness\". This is equivalent to calling `truthy' with the SHALLOW argument non-nil." (truthy obj 'shallow)) ;;;###autoload (defun truthy-l (obj) "Return non-nil if OBJ has lengthwise \"truthiness\". This is equivalent to calling `truthy' with the LENGTH argument non-nil." (truthy obj nil 'length)) (provide 'truthy) ;; ;; Emacs ;; ;; Local Variables: ;; indent-tabs-mode: nil ;; mangle-whitespace: t ;; require-final-newline: t ;; coding: utf-8 ;; byte-compile-warnings: (not cl-functions redefine) ;; End: ;; ;; LocalWords: Truthy truthiness ARGS alist devel truthy mapcar EIEIO ;; LocalWords: defstruct subseq utils eieio subr structs struct ;; ;;; truthy.el ends here