Download
(require 'custom)
(defgroup profiles nil
"*Profiles."
:group 'profiles)
(defcustom profile-path-alist-file "~/.emacs.profiles"
"*The file that will contain the `profile-path-alist'."
:group 'profiles
:type 'file)
(defcustom profile-path-alist nil
"*An alist of pairs formed by (REGEXP . PROFILE-NAME). Both are
strings. If the path of the file in the current buffer matches
REGEXP, then the corresponding profile is used. If there are no
matches, the default value of `profile-current' is used
instead."
:group 'profiles
:type 'alist)
(defvar profile-obarray
(let ((intern-obarray (make-vector 7 0)))
(intern "default" intern-obarray)
intern-obarray)
"The alist of available profiles. The first member of the cons
is the profile name and the second member is the profile
parameters.")
(defvar profile-current (intern-soft "default" profile-obarray)
"Buffer local variable that contains the current profile. Add
more profiles using `profile-create' in your \"~/.emacs\" or
interactively.")
(defun profilep (arg)
"Return t if arg is a profile, nil otherwise."
(if (intern-soft arg profile-obarray) t nil))
(defun profile-set-current (profile-name)
"Make PROFILE-NAME the current profile. The current profile is
a buffer local variable"
(unless (intern-soft profile-name profile-obarray)
(error "Profile " profile-name " does not exists"))
(setq profile-current (intern-soft profile-name profile-obarray)))
(defun profile-set-default (profile-name)
"Make PROFILE-NAME the default profile. The profile must exists."
(interactive "i")
(if (interactive-p)
(setq profile-name
(completing-read "Set default profile: "
profile-obarray nil t
(symbol-name profile-current)))
(unless (intern-soft profile-name profile-obarray)
(error "Profile " profile-name " does not exists")))
(set-default 'profile-current (intern-soft profile-name profile-obarray)))
(defun profile-define (profile &optional name mail &rest plist)
"Create or replace PROFILE with NAME and MAIL. PROFILE, NAME
and MAIL are all required to be string values. Optional argument
PLIST is a property list."
(interactive "i")
(if (interactive-p)
(progn
(setq profile (read-string "Name of the profile: "))
(setq name (read-string "Your name: "))
(setq mail (read-string "Your mailing address: ")))
(unless (stringp name) (error "Parameter profile is not a string"))
(unless (string-or-null-p name) (error "Parameter name is not a string"))
(unless (string-or-null-p mail) (error "Parameter mail is not a string")))
(setplist (intern profile profile-obarray)
(append (list 'name name 'mailing-address mail) plist)))
(defun profile-put (profile property value)
"Put PROPERTY's VALUE into PROFILE or replace any existing
value."
(unless (stringp profile) (error "Parameter profile is not a string"))
(unless (intern-soft profile profile-obarray)
(error "Profile " profile " does not exists"))
(put (intern-soft profile profile-obarray) property value))
(defun profile-get (profile property)
"Get PROPERTY's VALUE from `profile-current'."
(unless (stringp profile) (error "Parameter profile is not a string"))
(unless (intern-soft profile profile-obarray)
(error "Profile " profile " does not exists"))
(get (intern-soft profile profile-obarray) property))
(defun profile-current-put (property value)
"Put PROPERTY's VALUE into the `profile-current' or replace any
existing value."
(put profile-current property value))
(defun profile-current-name nil
"Return the name for `profile-current'."
(get profile-current 'name))
(defun profile-current-mailing-address nil
"Return the mailing address for `profile-current'."
(get profile-current 'mailing-address))
(defun profile-current-get (property)
"Return the value of PROPERTY for the current profile
`profile-current'. The returned property is not evaluated."
(get profile-current property))
(defun profile-current-eval (property)
"Return the evaluation of PROPERTY's value for the current
profile `profile-current'."
(eval (get profile-current property)))
(defun profile-load-path-alist nil
"Load the path alist from `profile-path-alist-file'."
(interactive)
(when (file-readable-p profile-path-alist-file)
(load-file profile-path-alist-file)))
(defun profile-save-path-alist nil
"Save the path alist to `profile-path-alist-file'."
(interactive)
(when (file-writable-p profile-path-alist-file)
(with-temp-file profile-path-alist-file
(insert "(setq profile-path-alist (quote")
(print profile-path-alist (current-buffer))
(insert "))"))))
(defun profile-find-path-alist (&optional filename)
"Scans `profile-path-alist' to find the matching profile for
the FILENAME or return the default value for `profile-current'.
If FILENAME is nil, then match against the buffer's current file
name, or the buffer's name."
(or
(assoc-default (or filename (buffer-file-name) (buffer-name))
profile-path-alist 'string-match)
(symbol-name (default-value 'profile-current))))
(defun profile-add-regexp-and-save (regexp profile-name)
"Add an element to the `profile-path-alist'. Request a REGEXP
and a specific PROFILE-NAME from the user if called
interactively."
(interactive "i\ni")
(if (interactive-p)
(progn
(setq regexp (read-file-name "Path regexp: "
(buffer-file-name)))
(setq profile-name
(completing-read "Apply profile: "
profile-obarray nil t
(symbol-name profile-current))))
(unless (intern-soft profile-name profile-obarray)
(error "Profile " profile-name " does not exists")))
(setq profile-path-alist
(cons (cons regexp profile-name) profile-path-alist))
(profile-save-path-alist))
(defun profile-find-file (filename profile-name)
"Modify `profile-path-alist', call `profile-save-path-alist' to
remember the modification and open a file using `find-file'. This
function allows a user the open the file FILENAME with a
different profile PROFILE-NAME than the default profile and
remember this setting."
(interactive "GFind file: \ni")
(if (interactive-p)
(setq profile-name
(completing-read "Apply profile: "
profile-obarray nil t
(symbol-name profile-current)))
(unless (intern-soft profile-name profile-obarray)
(error "Profile " profile-name " does not exists")))
(setq profile-path-alist
(cons (cons filename profile-name) profile-path-alist))
(profile-save-path-alist)
(find-file filename))
(defadvice find-file-noselect-1
(before before-find-file-noselect-1 activate)
"Set the buffer local variable `profile-current' right after
the creation of the buffer."
(with-current-buffer buf
(make-local-variable 'profile-current)
(put 'profile-current 'permanent-local t)
(setq profile-current
(intern-soft (profile-find-path-alist filename) profile-obarray))))
(provide 'profiles)