;;; Flags --- Flags library of FG42 -*- lexical-binding: t; -*- ;; ;; Copyright (c) 2010-2021 Sameer Rahmani & Contributors ;; ;; Author: Sameer Rahmani ;; URL: https://gitlab.com/FG42/FG42 ;; Version: 3.0.0 ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;; ;;; Commentary: ;;; Code: (require 'seq) (require 'fg42/core) (defvar fg42/available-flags nil "A list of defined flags. Only use \\[defflag] to add a new flag to this list") (defcustom fg42/flags nil "A set of flags to mark the functionalities that expected from FG42. Flags are defined using the \\[defflag] through out the source code. To see a list of available flags use \\[fg42/show-all-flags] and to see the documentation of each flag simply use \\[describe-flag]." :group 'fg42 :package-version '(FG42 . "3.x") :type '(symbol) :tag "FG42 Flags") (defmacro use-flags (&rest flags) "Set the given FLAGS to activate their functionalities in FG42." (setq fg42/flags flags) t) (defun fg42/-merge-flags (flags-set &rest new-flags) "Merge the given NEW-FLAGS into the FLAGS-SET and return the result." (remove-duplicates (seq-reduce (lambda (result flag) (let ((flag-str (symbol-name flag))) (if (string-prefix-p "-" flag-str) (let ((actual-flag (intern (substring flag-str 1)))) (if (member actual-flag result) (remove actual-flag result) result)) ;; We don't want to check for duplicates here since we remove them ;; later (cons flag result)))) new-flags flags-set))) (defmacro fg42/merge-flags (flags-set &rest new-flags) "Merge the given NEW-FLAGS into the FLAGS-SET and return the result. If any flag name in NEW-FLAGS list starts with `-' (a dash) it implies that that functionality has to be disabled and removed from FLAGS-SET. For example, `-lsp' implies that we DO NOT want to have `lsp' flag enabled and it should not exist in the return value. For example, `(fg42/merge-flags (list f1 f2 f3) f4 -f2)' will return `(f1 f3 f4)'" `(fg42/-merge-flags ,flags-set ,@(mapcar (lambda (x) `',x) new-flags))) (defmacro defflag (flag-name docstring) "Define a new flag FLAG-NAME with the given DOCSTRING." (let ((var-name (intern (format "fg42/-flag-%s" flag-name)))) `(if (boundp ',var-name) (warn (format "Flag name `%s' already defined" ,(format "%s" flag-name))) (progn (defvar ,var-name t) (add-to-list 'fg42/available-flags ',flag-name))))) (defmacro when-flag (flag &rest body) "Evaluate the BODY only if the given FLAG is active." (declare (indent defun)) ;; The `cube-local-flags' variable here is going to be ;; defined in cubes to hold the local flags for each cube (if (and (boundp 'cube-local-flags) (member flag cube-local-flags)) `,@body `(if (member ',flag fg42/flags) ,@body nil))) (defmacro if-flag (flag then else) "Evaluate the THEN expr only if the given FLAG is active otherwise ELSE." (declare (indent defun)) ;; The `cube-local-flags' variable here is going to be ;; defined in cubes to hold the local flags for each cube (if (and (boundp 'cube-local-flags) (member flag cube-local-flags)) `,@then `(if (member ',flag fg42/flags) ,then ,else))) (provide 'fg42/flags) ;;; flags.el ends here