namedmarks.el

;; LCD Archive Entry:
;; namedmarks|Ken Manheimer|ken.manheimer@gmail.com
;; |Per-buffer marks referred to by name, with completion
;; |29-Dec-1992|V 2.0||
;;
;; named marks
;;
;; Copyright (C) 1991,2011 Ken Manheimer and Free Software Foundation, Inc.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;
;; modified: 14-Sep-1993 bwarsaw@cen.com (ported to lemacs 19.8)
;; modified: 29-Dec-1992 bwarsaw@cen.com (ported to emacs 19)
;; modified: 18-Jun-1992 bwarsaw@cen.com (named marks are now really markers)
;; modified:  3-Nov-1989 bwarsaw@cen.com (added provide)
;; created : ?1987? ken manheimer, klm@cme.nist.gov (a long time ago)



;; state variables
(defvar nm:named-marks (list nil)
  "Internal buffer-local named mark list.")
(make-variable-buffer-local 'nm:named-marks)

(defvar nm:last-refd-mark-name ""
  "Internal buffer-local handle on last named mark.")
(make-variable-buffer-local 'nm:last-refd-mark-name)


(defun nm:set-mark-command (arg)
  "Like normal set-mark unless invoked with a repeat count.
With a repeat count less than 16, the mark is set and associated with
a name (prompted for).  Repeat count greater than 16 causes a
'jump-to-mark' operation simpilar to set-mark-command with an
argument.  Use \\[nm:goto-mark] with repeat count to return to named
marks.  Named marks are buffer specific."
  (interactive "p")
  (cond
   ((= arg 1)				;no repeat count given
    (set-mark-command nil))		;call built-in set-mark-command
   ((< arg 16)
    (let* ((name
	    (completing-read
	     (if (not (string= nm:last-refd-mark-name ""))
		 (format "Set mark named (default %s): "
			 nm:last-refd-mark-name)
	       "Set mark named: ")
	     nm:named-marks))
	   (cell (assoc
		  (if (not (string= name ""))
		      name
		    (if (not (string= nm:last-refd-mark-name ""))
			(setq name nm:last-refd-mark-name)
		      (error "No name indicated - mark not set")))
		  nm:named-marks)))
      (if cell				      ; if name already established
	  (rplacd cell (list (point-marker))) ; associate it with new pos,
	(setq nm:named-marks		      ; or create entire new entry.
	      (cons (list name (point-marker)) nm:named-marks)))
      (message "Mark `%s' set" (setq nm:last-refd-mark-name name))))
   (t (set-mark-command t))
   ))

(defun nm:goto-mark (arg)
  "Exchange point and mark unless invoked with a repeat count.
With repeat count less than 16, point is moved to the mark associated
with the prompted name (completion supported). With a repeat count
greater than or equal to 16, the prompted named mark is deleted from
the list. Named marks are buffer specific."
  (interactive "p")
  (cond
   ((= arg 1)
    (exchange-point-and-mark))
   ((= 1 (length nm:named-marks))
    (error "No named marks in this buffer."))
   ((< arg 16)
    (let* ((name
	    (completing-read
	     (if (not (string= nm:last-refd-mark-name ""))
		 (format "Goto mark named (default %s): "
			 nm:last-refd-mark-name)
	       "Goto mark named: ")
	     nm:named-marks nil t)))	; require established name
      (goto-char
       (car (cdr (assoc (if (not (string= "" name))
			    (setq nm:last-refd-mark-name name)
			  (if (not (string= nm:last-refd-mark-name ""))
			      nm:last-refd-mark-name
			    (error "No established named marks")))
			nm:named-marks))))))
   (t (let* ((name
	      (completing-read
	       (if (not (string= nm:last-refd-mark-name ""))
		   (format "Kill mark named (default %s): "
			   nm:last-refd-mark-name)
		 "Kill mark named: ")
	       nm:named-marks nil t))
	     (cell (assoc
		    (if (not (string= name ""))
			name
		      (if (not (string= nm:last-refd-mark-name ""))
			  (setq name nm:last-refd-mark-name)
			(error "No name indicated - mark not killed")))
		    nm:named-marks)))
	(if cell
	    (progn
	      (set-marker (car (cdr cell)) nil)
	      ;; find the cdr pointing to this cell
	      (setq nm:named-marks (delq cell nm:named-marks))))))))

(defun nm:pop-mark-command (arg)
  "Pop ARG marks and go to remaining exposed mark."
  (interactive "p")
  (if (null (mark))
      (error "No mark set in this buffer")
    (progn
      (while (> arg 0)
	(pop-mark)
	(setq arg (1- arg)))
      (goto-char (mark)))))



(provide 'namedmarks)
;; eof