; Emacs lisp code:


;; XX Tom Popovich (tjp) contributions on better key bindings:  [Strip off the ;; XX and put in your .emacs file]
;; XX 
;; XX ;;;
;; XX ;; code to define keybindings that use set/goto namedmarks.el functs as author intended
;; XX (global-set-key [(shift f5)] 'nm:set-mark-command)
;; XX (global-set-key [(f5)] 'nm:goto-mark)
;; XX ;;; 
;; XX ;; better tjp code to define keybindings to easily use set/goto namedmarks.el functs directly - no need to use C-U, just F5 and Shift-F5
;; XX (global-set-key [(shift f5)] (lambda () (interactive) (nm:set-mark-command 15)))
;; XX (global-set-key [(f5)] (lambda () (interactive) (nm:goto-mark 15)))
;; XX ;;;
;; XX 

;; LCD Archive Entry:
;; namedmarks|Ken Manheimer|klm@cme.nist.gov
;; |Per-buffer marks referred to by name, with completion
;; |29-Dec-1992|V 2.0||
;;
;; named marks
;; 
;; Copyright (C) 1991 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; 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? 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